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B 
**F 1LE®*1D**BASOPEN 
BBBBBBBB ARRARR SSSSSSSS 000000 PPPPPPPP 
BBBBBBBB Fla hb SSSSSSSS 000000 PPPPPPPP 
BB AA AA SS 00 00 PP 
BB BB AA AA SS 00 00 PP 
BB AA AA SS 00 00 PP 
88 BB AA AA SS 00 OO PP 
88888888 ab AB SSSSSS 00 00 PPPPPPPP 
BBBBBBBB Aa Ad SSSSSS 00 00 PPPPPPPP 
8B BB AAAAAAAAAA SS 00 00 PP 
BB BB AAAAAAAAAA SS 00 00 PP 
BB BB AA val SS 00 00 PP 
BB BB AA ab SS 00 00 PP 
Bi Ab AA SSSSSSSS 000000 PP 
BBBBBBBB Ae AA SSSSSSSS 000000 PP 
LL I1111 SSSSSSSS 
LL 11111 SSSSSSSS 
LL I] SS 
LL I] S$ 
LL I] S$ 
LL 1] SS 
LL 1] SSSSSS 
LL I] SSSSSS 
LL 1] SS 
LL I] SS 
on I] SS 
LL I] SS 
LLLLLLLLLLE 111111 SSSSSSSS 
LLLLLLLLLL M1111 SSSSSSSS 
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14-Sep-1984 4 BASRTL. 
MODULE BASSOPEN ( ! OPEN a gasic channel 
pean = *1-113' ! File: BASOPEN.B32 Edit: KC1113 


BEGIN 
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ie COPYRIGHT (c) 1978, 1980, 1982, 1983, 1984 BY 
ie DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. 
ie ALL RIGHTS RESERVED. 


ie THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED 
:* ONLY IN ACCORDANCE WITH THE R H_THE 
: 0 

:* OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY 
!® TRANSFERRED. 

!® THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE 
:: PORPORAT ton NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT 


ie DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 
‘* SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 


VeRO REE RAE AEEAERAE AERA AEE AEREA EAA AEE EAE RAE RET EEEAERAREREAKREERRA Ree 
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FACILITY: VAX=-11 BASIC 1/0 Processing 
ABSTRACT: 


This module contains the BASSOPEN routine, which opens a file 
for a VAX-11 BASIC program. 


ENVIRONMENT: VAX-11 User Mode 
AUTHOR: John Sauter, CREATION DATE: 30-NOV-78 
MODIFIED BY: 


1 - Original. JBS 30-NOV-78 

1 - Change REQUIRE file name from FOR... to OTS... JBS 06-DEC-78 
1 - change OPENSK symbols to LUBSK. JBS 08-DEC-78 

1-004 = REQUIRE BASOPN to get default record pongth. JBS_12-DEC-78 

1 - Call BASSCB_PUSH and POP instead of FORSS. JBS 29-DEC-78 

1 - Update this module to use the new OPEN calling sequence 

and semantics gee ides on in the 12-FEB-1979 meeting. 

JBS 14-FEB-197 
1-007 = Set LUBSV_USER_RBUF if the record buffer is taken from the 

MAP parameter instead of allocated from virtual storage. 

JBS 16-FEB-1979 : . : 
Clear the LOCATE bit in the RAB if the user provides his own 
buffer, so the data will always be placed in it. JBS 19-FEB-1979 
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1-1) 14-Sep-1984 BASRTL.SRCJBASOPEN.B32;91 
oe. | p08 1 ! 1-009 = Use 1/0 error codes from BASIOERR.REQ. JBS see haga 3484 

; 059 1 ! 1-010 = if the device being opened is a terminal, set the 

; 0060 1! margin based on the BLS field of he FAB, JPS SocF 821979 
; 6! od : } 1-011 - e x'P the A 4 OW SCRATCH clause; it implies no sharing. 

: ~~ § 0065 1°! 1- \ = Add ORGANIZATION INDEXED. JBS O8-MAR-1979 

> 64 0064 1 ! 1-015 = Don't use summary XABs until I can learn how jes 08-MAR-1979 
; & 0065 1 ! 1-014 = Set up the key buffer and size fields of the. ~~ 1998 26-MAR-1979 
; 0066 1 ! 1-015 - If the user provides a MAP, null it. JBS 04- 

; of 0067 1 ! 1-016 = Accept we date gt hes. if the user scantden emes 

; o& 0068 1! JBS 06-A 

; §9 0069 1 ! 1-017 = Set up (UBS. ORGAN on anew file. JBS 06-APR-1979 

;: 0070 1 ! 1-018 - Verify keys properly for an existing indexed file. Jes 06-APR-1979 
; 71 0071 1 ! 1-019 = If we allocate a proapt gbyfter. set its current Length 

; 72 0072 1! to zero. JBS 09-A 

Fe 0075 1 ! 1-020 = OPEN on channel 0 ~See an error message, and on any other 

: 74 0074 1! open channel closes the channel first. JBS 12-APR-1979 

: 75 0075 1 ! 1-021 = The default E cecere format for VIRTUAL files is FIXED. 

:-. 0076 1! JBS 19=AP 

: 77 0077 1 ! 1-022 = Implement PO TREAR, since it is in the Gong tter. Note: 

: 78 0078 1! rest of wo a does not implement STREAM. JBS TS eAPRe1979 
3 lA) 0079 1 ! 1-023 = Add LUBS$B_R for the FSP$ function. JBS” 19-APR-1 979 

: 80 0080 1! 1-024 = Add STATUS ses 19=APR=-1979 

; 3 sie : 1-025 - _ t LUBSY TERM. FOR if gr i is a terminal format file. 

3 83 0083 1! 1-026 - r "RECORDS IZE is specified on a terminal format file, set 

> BG 9084 1: he MARGIN and DEFAULT MARGIN to it. JBS 18-MAY-1979 

; 85 0085 1! 1-027 - Don't oes . recordsize of 0 on an old file. 

5; 0086 1! JBS 22-MAY-1979 

: 87 0087 1! 1-028 - aot MRS a. ithe computed record size, in case it defaulted. 

; 008s 1! JBS 24-MAY-1979 

5; we 0089 1 ! 1-029 - cores an pr bug in STATUS. It has not been tested. 
: 0090 1! JBS 24-MAY-1979 

: 91 0091 1 ! 1-030 - Set LUBSV_FORCIBLE if the device is a terminal. 

2. ¥ 0095 1! JBS 24-MAY-1979 

: 9 0095 % ! 1-031 = Set RABSV_UIF for ure eyes files. JBS 25-MAY-1979 

s 0094 1 ! 1-032 = Change from esr O nevs to LUBS$V_KEYED. JBS 30-MAY-1979 
: 95 0095 1! 1-033 - change wergin $ it JBS 30-MAY-1979 

;° © 0096 1 ! 1-034 = Add BASS$S ATU. INIT. BS 04-JUN-1979 

: 0097 1 ! 1-035 - Set the Language byte in the LUB, so ~~ A wrth? 1/0 

: 98 0098 1! statements can be used on files opened in Sa 

: oy 0099 1! This pecan res "a8 oo 2 be, colenes in some i 

; 100 0100 1! release. JBS 5 -1 

: 101 0101 1 ! 1-036 - If the device is. a ee ghenge to PRN format so it 

i 108 O12 1 | >. 1'8 forcible. Jes 10-JuL- -197 

: 10 0105 1 ! 1-987 - japlenent 5 STR REAR’ Me. real (see edit ge JBS 12-JUL-1979 
: 1046 0106 7! .-v files must be VFC format. JBS 17-JUL-1979 

s 105 0105 1! 1-03 - Add e ip oyere” as the third argument to USEROPEN. 

; 106 0106 : 2 JBS 25- 1979 

: 107 0107 1 ! 1-040 = Set . TSBSA USER_FP. JBS 25-JUL-1979 

: 108 B18 1 ! 1-041 - Make LUB$Q_BFA_QUEVE empty. JBS 30-JUL-19 

: 109 109 1 ! 1-042 = Don't allow ACTE EAD to create a file. JBS 30-JUL-1979 

; 110 110 1 ! 1-045 - Make sure the LUB/ pate sts deallocated if we must 

2 111 bh ee Be “bail out”. JBS 35i-J 9 

: 44 M6 1 ! 1-044 = Don’t fool sith tuBse. RSL and LUBSA_RSN until we are sure 

ees | | 011 1! the LUN is not open. Any error messages should show the 

3; «116 0114 1! previous file name. JBS 08-AUG-1 
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SYS SCCSCSOCOCELLA LILI LELE SS: BREE EE EWN 2 
w 
ee ee ee a a ed od dd od = dd od od od dd = 3 
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Set NOTSEQORG for all but terminal and Segyant tal files, 
$o $$10 BEG can use it. JBS 08-AUG-1 
If ACCESS READ, assume FOR INPUT. JBS 08-AUG-1979 
Use the BASIC-specific exit handler. JBS 1/7-AUG-1979 
Be sure to RMS close the file if an_error 43 detected after 
the RMS OPEN is successful. JBS 23-AUG-1979 ; 
Rearrange MARGIN and RECORDSIZE defaults for compatability 
with the PDP-11. Now, terminal format files on disk have 
margin of 72, whereas terminal format files on terminals 
have infinite margin. JBS 24-AUG-1979 
Correct a typo in the computation of bucket size. JBS 04-SEP-1979 
Disable locate _ mode until we get a chance to debug it. 
JBS 12-SEP-1979 i 
Remove STREAM and add record gttribuses. JBS 13-SEP-1979 
Re-enable locate mode. JBS 15-SEP-1979 ; 
Deafult record atrribute for an old virtual file may be NONE or CR. 
JBS 15-SEP-1979 = 
Give an error message for the CONNECT clause until it is implemented. 
JBS 19-SEP-1979 
Remove references to LUB$Q_BFA_QUEUE, no longer needed. 
JBS 19-SEP-1979 : 
Implement CONNECT for indexed files. JBS 30-SEP-1979 
amorous the error message for mismatch of record attributes. 
JBS 03-0CT-1979 , ; ‘ 
Don't demand any porticuter record format if the organization is 
is UNDEFINED. JBS 12-0CT-1979 ; ; 
Allow any record format, even UNDEFINED, if the organization is 
undefined. JBS 12-0CT-1979 , oS. ead 
If this is a VFC file, make sure the VFC field size is right. 
JBS 15-OCT-1979 
If the argument List says FOR OUTPUT, set the FABSV_SUP bit, so 
that an explicit version number in the file name will delete 
and recreate an qeteteng file. QAR N11-02971 JBS 22-0CT-1979 
Round the block size up to a sultiols of 4 bytes. JBS 25-OCT-1979 
Fix an error message. JBS 07-NOV-1979 
Improve the interface to USEROPEN. JBS 07-NOV-1979 
Change virtual arrays to_automatic record locking. JBS 09-NOV-1979 
Set up LIBSA_UBF. JBS 13-NOV-1979 
Make sure the record buffer is at least as large as the user's 
declared ‘‘buffer size’’, or the default for the organization, 
if mone was declared. JBS 27-NOV-1979 
Don't ever turn on RMS Locate Mode. DGP 29-Nov-79 
Correct an error in edit 1-068. JBS 05-DEC-1979 
If the record size test fails on an existing file qive 
BAD RECORDSIZE VALUE ON OPEN rather than FILE ATTRIBUTES NOT 
MATCHED. This error was found by FEATS. JBS 28-DEC-1979 
Change ‘‘Run Time syntax Error’ to a ronan Lost Sorry"*. DGP 07-Jan-80 
Change OPEN_HANDLER to clean up the I/0 data base before signalling 
in the event of ; govers error. DGP 08-Jan-80 
Complete edit 1-075. JBS 09-JAN-1980 
Improve compatability with the PDP-11: round block size up to 20, 
don't set ABSY RUC and don't check FABSB_RFM if it is defaulted. 
JBS 14-JAN-1980 ; 2 
Another conpeteb tt tty chance! If the ALL clause is omitted, let 
RMS default the FABSB_SHR field. JBS 15-JAN-1980 
The bucket size field Ts a word, not a byte, JBS 01-FEB-1980 
Use 1 for default blocksize in Open. DGP 12-Feb-1980 
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1-079 - Always round recordsize for virtual files to next higher pul tigte 
of 5i2. Check file attributes against temp RSZ. DGP 12-Feb-8 
1-080 - Complete edit 1-079. JBS 135-FEB-1980 
1-081 - A_ Virtual file must be sequential and have fixed-length records. 
The buffer size (record size) must be greater than or equal to 

512 myers, If it is less, round it up unless the user supplied a 
map, in which case we have an error. Round the record size down 
if pocessery to make it even. JBS 12-JUN-1 
mt - Put FABSL_ALQ in LUBSL_ALQ and initialize LUBSL_REC_MAX. FM 22-SEP-80 

- In order fo be able to OPEN a spooled terminal just like any other 


17 


e that 
the file is a terminal and we close and reopen (reCREATE). FM 4-FEB-81 
1-084 - If organization is UNDEFINED, and recordsize is 0 then signal 
BADRECVAL. FM 5-FEB-81 
1-085 = Set FAC to null before oe macro $FAB_LINIT. If this is not done 
the opener gets read access automatically. PL 20-AUG-81 
1-086 - Set FABSV_MSE unconditionally if organization is indexed, so a 
subsequent CONNECT can work. Also, if caller is tryin to CONNECT 
to a child, instead of a parent signal INVFILOPT. FM 20-AUG-81 
1-087 - LIBSSTOP should be declared EXTERNAL. PLL 20-Nov-81 ; 
1-088 - If the user specifies a recordsize less than the file record size, 
do not give an error. PLL 13-Jan-82 ; : 
1-089 = Check the recordsize of a variable length record file only if 
MRS is set. PLL 22-Feb-82 ‘ 
1-090 - Check 089 should be made only if the file is opened for write access. 
Rather than a the recordsize of a variable length record file, 
gust let RMS catch the error. PLL 9-Mar-1982 
1-091 = Yet another fix for recordsize. RBUF can be larger than the recordsize 
specified in the OPEN block. PLL 3-May-1982 


terminal, make the SOPEN macro a $SCREATE macro after we - 
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201 Add support for manual record locking. If the user specifies ‘UNLOCK 

202 EXPLICIT’’ in the OPEN statement, set the ULK bit in the RAB ROP. 

203 PLL 2-Jun=1982 : . 

204 1-093 - Add check for recordsize that exceeds the MAP buffer size. PLL 2-Jun-1982 
205 1-094 = Add support for segmented heye- PLL 3=Jun-1982 

206 1-095 - Fix bug in setting RAB ROP ULK bit. PLL 8-Jun-1982 

id 44 - For V2, if the RECORDSIZE is 0, use the MAP size. PLL 9-Jun-1982 


For pepeanres keys, the lengths and the posts tens of all segments 
specified by the user must be checked. PLL 9-Jun-1982 
1-098 - For v2, if there is no MAP don't compare the MAP size to the 
recordsize. PLL 11-Jun-1982 
1-099 - Fix problem of two files being queued when output file is a spooled 
terminal. Instead of CLOSEing and re-CREATEing after initial CREATE 
tells us the device is a sree ed terminal, simply do a PARSE to see 
if it is, ang fix up the FAB and RAB accordingly prior to the CREATE. 
MDL 16-Jun-1982 eyes 
1-100 - Add check for printer as output “‘file’’ on OPEN statement; ges default 
and right margins to printer width if it is. MDL 17-Jun-1982 
1-101 - arnt rocerves e/map size check so that it includes new files also. 
-Jule? 

1-102 - when CONNECT is gpec tt ted but indexed is not, allow check of 

arent file attributes (to see if its indexed & therefore OK) 
efore giving an error. MDL 19-Jul-1 
1-103 = when UNLOCK BxPcicit is specified for a non-512 byte fixed-length 
sequential file, issue an error. mot 20-Jul-19 
1-104 = only check for UNLOCK EXPLICIT on V2 programs. MDL 21-Sep-1982 
1-105 = enabled commented-out code on summary XABs. Added check of declared 
key type vs. existing key type for indexed files. 
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1-11 12-8 8-13be 1 3 724 BASRTL.SRC IBASOPEN.B32;91 : (1) 
$ 9 0229 1! MDL 28-Sep-1982 
; 0 0230 1 ! 1-106 = for Vv progrens. if there is not a recordsize but there is a map 
: 1 O23) 1 ! size, then the map size should be used to as the default right 
3 @ g 0 : 1 / margin rather than the BASIC default. MDL 9-Sep=1 
3 0 1 ! 1-107 = for indexed files, only give an error if the number of keys the 
; 0234 1! user specifies is MORE than the number of keys 90 the file, rather 
; 5 0235 1! than looking for an exact match. MDL 15-Oct-19 
; 6 0236 1 : 1-108 - update UNWIND CCB when we have to drop R11 and pick it up again, 
B gor 0237 1! in the case of opening a channel that's already open somewher 
> 238 0238 1! else (and therefore needs to be closed first). MDL 5-Jan<-198 
> 239 0239 1 ! 1-109 = for V2 programs, signal BADRECVAL if the user attempts to geen 
; 240 Bseo 1! a file with MRS with a MAP that is too small. MDL 6-Jan-19 
> 261 0241 1 ! 1-110 = don't be gyice so picky about a data types matching oanes re 
; Bseg 1! indexed files - Basic has no unsigned data type, but indexed files 
> 246 02435 1! can have unsigned sere, MDL 29-A a 17 
> 2446 0244 1 ! 1-111 = allow OPEN of SYSSINPUT with ORG=UNDEFINED. also, look at FAB$W_BLS 
> 245 0245 1! to determine actual recordsize, along with MRS and LRL. MDL 22-Feb-1984 
: 246 0246 1! aii¢ - take recordsize from the file if it isn't specified. MDL 53-May-1984 
: 247 0247 1! 1-115 = Fix 1-112. Use recordsize from the file only if the recordsize 
; 248 0248 1! was not specified and the maximum recordsize (FABSW_MRS) is 
: 249 0249 1! not zero. KC and MDL and AKS 07-Sep-1984. 
; 250 0250 1 !-- 
5 ae 0251 1 
; 252 0252 1 !<BLF/PAGE> 
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; SWITCHES: 
SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE); 
! 


LINKAGES: 


REQUIRE "RTLIN:OTSLNK'; 


define Linkages 


; TABLE OF CONTENTS: 


FORWARD ROUTINE 
BASSOPEN : NOVALUE, ! Open a file 
OPEN_HANDLER, ' Condition handler for OPEN 
BASS Status of last file opened 


STATUS, 
BASSSSTATU_INIT : NOVALUE; Initialize status for RUN command 


: INCLUDE FILES: 


REQUIRE "RTLIN:RTLPSECT'; 
REQUIRE ‘RTLML:OTSLUB'; 
REQUIRE ‘RTLML:OTSISB'; 
REQUIRE ‘RTLIN:BASOPN'; 
REQUIRE "RTLIN:BASIOERR'; 
LIBRARY ‘RTLSTARLE'; 


Macros for defining psects 


Logical Unit Block definitions 
ISB definitions 

OPEN Literals 

1/0 error codes 


system definitions 


1! 

: MACROS: 

NONE 

: EQUATED SYMBOLS: 


'¢ 
The following symbols refer to arguments of BASSOPEN. 


LITERAL 

OPNSK_ORG_TERMI = 0, ! no oreeni rotten sper if ted : 

OPNSK-ORG_VIRTU = 1, | ORGANIZATION VIRTUAL specified 

OPNS$K_ORG_SEQUE = ¢: ! ORGANIZATION SEQUENTIAL specified 

OPNSK_ORG_RELAT = 35, ! ORGANIZATION RELATIVE specifie 
-ORG_INDEX = 4, : bay eg bo INDEXED specified 

OPNSK_ORG_UNDEF = 5, ' ORGANI ZATION Uns? LNED specified 

OPNSK_ACC_DEFAU = 0, !' mo access specified ( = MODIFY) 


1 
BASSOPEN 1bse -1984 00:52:31 AX-11 Bliss-32 V4.0-742 Page 
assy 14-Sep-19 4 09:38:34 EBASRTL SRC BASOPEN.B32;91 (2) 
11 1237 1 OPNSK_ACC_MODIF = 1, ' ACCESS MODIFY specified 
\§ 1238 1 OPNSK_ACC_WRITE = 2, ' ACCESS WRITE specified 
1 1239 1 OPN$K_ACC_READ = 3 ! ACCESS READ specified 
14 1240 1 OPNSK-ACC-SCRAT = 4, i ACCESS SCRATCH specified 
15 1241 1 OPNSK_ACC_APPEN = 5, ' ACCESS APPEND specified 
16 1 ¢g 1 OPNSK_RFM_DEFAU = 0, ‘ record format not specified 
17 124635 1 OPNSK_RFM_FIXED = 1, ! FIXED specified 
18 1244 1 OPNSK_RFM_VARIA = 2, ! VARIABLE specified 
19 12465 1 OPNSK_RFM_VFC = 3, ! VFC specitied 
20 1 46 1 OPNSK-RFM-STREA = 4, i STREAM specified 
21 1247 1 OPNSK_ALL_DEFAU = 0, ' no ALLOW clause 
356 1248 1 OPNSK_ALL_MODIF = 1, ' ALLOW MODIFY specified 
12469 #1 OPNSK_ALL_WRITE = 2, ' ALLOW WRITE specified 
$e 1250 1 OPNSK_ALL_READ = 3 ! ALLOW READ speci tied 
25 1251 1 OPNSK-ALL-SCRAT = 4, i ALLOW SCRATCH specified 
326 1536 1 OPNSK_ALL_NONE ! ALLOW NONE spect ied 
327 125 1 OPNSK-RAT_DEFAU = 0, i mo RECORDATTR clause 
328 1254 1 OPNSK_RAT_FORTR = 1, : RECORDATTR FORTRAN specified 
329 1255 1 OPNSK_RAT_CRLF = ¢ ! RECORDATTR CRLF specified 
330 1256 1 OPNSK_RAT_NONE = ! RECORDATTR NONE specified 
331 1257 1 OPNSK_RAT_PRINT = i, ! RECORDATTR PRINT specified 
33¢ 1258 1 OPNSK-RAT_ANY = 5; i RECORDATTR ANY specified 
33 1259 3 
334 1260 1 !+ = : ; 
$92 166) : The following codes specify how OPEN_HANDLER is to act on an UNWIND. 
337 15683 1 
338 1264 1 LITERAL ic 
339 1265 1 UNWIND_MIN = 0, ! Minimum UNWIND code 
340 1266 1 UNWIND_NOP = 0, ' Do meshing 
341 1267 1 UNWIND_POP = 1, ! POP the C(B 
342 1268 1 UNWIND_DEALLOC = 2, ! Deallocate (and POP) the CCB 
343 1269 1 UNWIND CLOSE = 3, ' RMS CLOSE the CCB, then deallocate and POP 
344 1270 1 UNWIND MAX = 3; ! Maximum UNWIND code 
345 1271 1 
346 127@ 1 LITERAL : 
347 1275 1 K_V1_BLK_SIZE = 52; ! Size of V1 OPEN argument block 
348 1274 1 
er 1275 1! 
50 1276 1 ! PSECTS: 
351 1277 13 KS 
$25 1s78 : DECLARE _PSECTS (BAS); ! Declare psects for BAS$ facility 
54 1¢80 1 ! OWN STORAGE: 
55 1281 1! 
56 1s8¢ 1 
57 1283 1 OWN : 
358 1284 1 LLSTATUS : INITIAL (0); ! Status of last file opened. 
59 1285 1 
0 1286 1! 
1 st 1 ! EXTERNAL REFERENCES: 
¢ 1288 1! 
1289 1 
64 1290 1 EXTERNAL 
44 : 4. : BASSSL_XIT_LOCK; ! Once-only flag for the exit handler. 
365 1598 1 EXTERNAL ROUTINE 
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LIBSSTOP : 
BASSSSTOP : NOVALUE . 
BASS$STOP_IO : NOVA 
BAS$$(B_POSH : JSB B bush NOVALUE, 
BASS$S$CB_POP : JSB_CB_POP NOVALUE, 
LIBSGET"VM, 

LIBSFREE_VM, 

ASSS$DECC_EXITH : NOVALUE, 
OTSS$$TAKE LUN, 

OTSSSCLOSE FILE, 

LIBSMATCH_COND; 


'¢ 
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nal fatal error 


4 
4 
Si 

Signals fatal error 


19:38:34 


i Signals fatal I/0 error 
! loads register CCB 
! completes LUN processing 


et virtual storage 
ree virtual storage 


i Declare exit handler 


OL out a “ogices unit number 
RMS Close a 


i Match a condition code 


q The following are the error codes used in this module. 


EXTERNAL LITERAL 

BASSK_RECOVEMAP : UNSIGNED (8), 
BAS$K_PROLOSSOR SIGNED (8), 
BASSK_ILLILLACC : UNSIGNED (8), 
BASSK_ILLIO_CHA : UNSIGNED (8), 
BASS$K_IO_CHAALR : UNSIGNED (8), 
BASSK_FATSYSIO UNSIGNED (8), 
BASSK_FILATTNOT : UNSIGNED (8), 
BASSK_RECATTNOT : UNSIGNED (8), 
BASSK_MAXMEMEXC : UNSIGNED (8), 
BAS$K_BADRECVA UNSIGNED (8), 
BASSK_NOTIMP : UNSIGNED (8), 

BASSK_INVFILOPT : UNSIGNED (8), 
BAS$K_IO_CHANOT : UNSIGNED (8), 
BASSK_REGRECSIZ : UNSIGNED (8); 


! <BLF /PAGE> 


RECORDSIZE overflows MAP buffer 

Program lost, sorry 

Illegal or illogical access 
Illegal 1/0 channel 

1/0 channel already open 

Fatal system 1/0 error 

File attributes not matched 

Record attributes not matched 
Maximum memory exceeded 

ae recordsize value on OPEN 

Not implemented 

Invalid file option 

1/0 Channel not open 

unlock explicit requires recordsize 512 
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OPNSW_MAP_SI 
OPNSV UNLOCK 
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'¢ 
! The following two fields describe the header on 
' and each key, respectively. 


FIELD 
OPNSKEYH_BLOCK = 
SET 


KEYHSB_KEYNUM = (0, 0, 8 
KEYHSB_LEN = (1, 0, 8, 03 


0), 


LITE 


RAL 
KEYHSK_LENGTH = 4; 
FIELD 


a a ae a a ee a a ee ee ee ee ee ee a a a a a ad ed ad dd 
oO 
v 
z 
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e following FIELD describes the OPEN_ARG_BLK argument of 
SSOPEN. 


AX=-11 at V4.0=-742 
BASRTL.SRC JBASOPEN.B32;91 (3) 


number of remaining bytes 
ORGANIZATION clause 
ACCESS clause 


' record format 


RO 
FOR INPUT specified 


! OPNSL_CHANNEL points to channel number 


Channel is 16 bits (ref only) 


! RECORDATTR clause 

! Size of VFC buffer 

! descriptor for file name string 
! size of 
! size of magtape block in bytes 
' address of user record buffer 
! size of file in blocks 

! extend size 

' bucket size in records 


record buffer in bytes 


number of retrieval pointers 
channel (LUN) to connect to 
number of 1/0 buffers - 
default name string descriptor 
address of user open procedure 
Channel number, or its address 
Address of VFC buffer 
Size of MAP buffer : 

set for manual record locking 


the KEY_INFO_BLK parameter 
Number of keys in this block 
Length of each KEY field 


Length of the key header 


BASSOPEN 
its 
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14-Sep-1984 24 CBASRTL.SRCJBASOPEN.B32;91 
ao = 

EYSB_LEN = (0, 0, 8, 0) ! Length of this key 
KEYSB-FLAGS = (1,°0, 8, 61, i Flags, as follows: 
KEYSV_DUP = fl. 6, f, 63. ' If set, duplicates are allowed 
KEY$V_CHG = (1, 1, 1, OJ, ' If set, changes are allowe 
KEYSW_OFFSET = (2, 0, 16, 0], ! Offset of this key in the record 
KEYSB-DTYPE = (4,0, 8, 6) i Data type of key 
KEYSB_NUM SEG = (5, 0. 8 63, i Additional # of segments 
KEYSB_LENT = (6, 9. , 01, ! Length segment 
Ke vou Orr ser! = (7, e. iS. 01, : fos tion segment 1 
KEYSB_LEN2 = (9, 0 0 ! Length segment 2 
se dd a ="(16, 6. 16, 01, : ms tion segment 2 
KEYSB_LENS = (12 g. » Bie ' Length segment 
KEYSW-OFFSET3 = (13, 0. 16, 02, ! position segment 3 
KEYSB_LENG = (15, 0, 8, OJ, ! Length segment 4 
KEYSWIOFFSET4 = (16, 0. 16. 0), ! position segment 4 
KEYSB_LENS = (18, 0, 8, OJ, : ength segment 5 
KEYSWIOFFSETS = £19, 0. 16. 02, ' pos tion segment 5 
KEYSB_LEN6 = (21, 0, 8, OJ, ' Length segment 6 
KEYSW-OFFSET6 = £22, 0. 16. 02, ! position segment 6 
KEYSB_LEN7 = (24, 0, 8, 0], ! Length segment 7 

OFFSET? = £25; 0. 16, 03 ! position segment 7 
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GLOBAL ROUTINE BASSOPEN ( 
OPEN_ARG_BLK, 
KEY_INFO_BLK 
) : NOVALUE = 


Lee 


i FUNCTIONAL DESCRIPTION: 


FORMAL PARAMETERS: 


OPEN_ARG_BLK.mz.r 
KEY_INFO_BLK.rl.ra 


IMPLICIT INPUTS: 
NONE 
IMPLICIT OUTPUTS: 
A lot of fields in the LUB. 


ROUTINE VALUE: 
COMPLETION CODES: 


NONE 
SIDE EFFECTS: 


to its caller. 


BEGIN 
BUILTIN 
ACTUAL COUNT; 
P 

OPEN_ARG_BLK : REF BLOCK £0, BYTE] FIELD 

KEY_TNFO_BLK : REF BLOCK CO, BYTE) FIELD 
LOCAL 

RSZ, 

BKS, 

BLS, 

NO_MAP_REC_SPECIFIED, 

OPEN_STATUS 

CONNECT_STATUS, 

CHANN 

FAB_BLOCK : $FAB_DECL, 


ee eae ee ee ed ed ae ce a a ce cae cae ce ce ce a a ee ce ae ae cae ee a ce ee ee ee ee ce ce ee ee ee ee ce ee ce ee ee ee ee ed 
Pe Oe oe oot ot ot ot ot et ek et ee, ek et et et 
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! Open a file 
! Argument List 
' Keys for ISAM 


( 
( 


Open a file for BASIC. This will always be an RMS file. 
Not all combinations of input options are valid. 


A long List of OPEN options. 
The keys, for ISAM opens. 


Either opens a file, thus permitting use of the channel number 
by BASIC 1/0 statements, or calls BASS$STOP, thus not returning 


OPNSARG, BLOCK) 
OPNSKEYA_BLOCKS; 


Computed record size 

Computed bucket size 

Computed blocksize 

Flag for W_RBUF_S 

computation. Sef in RSZ 
computation 

RMS status returned by SOPEN 
RMS status returned by SCONNECT 
The channel number 

Local FAB 
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4 FAB : REF $FAB_DECL ! pointer to FAB 

4 NAM BLOCK : SNAM_DECL, i local NAM block 

44 XABFHC : SXABFHC_DECL, ' Local XABFHC block 

545 M : $XABSUM~DECL i Local XABSUM block 

246 FILE_NAME_DESC : REF BLOCK CO, BYTE) i descriptor for file name 

4 LE-NAME~: BLOCK CNAMSC_MAXRSS, BYTE], | text for file name 

548 UNWIRD_ACTION : VOLATILE; i What to do on UNWIND 
UNWIND=CCB : VOLATILE; i what CCB to do it to 


GLOBAL REGISTER 
CCB = K_CCB_REG : REF BLOCK CO, BYTE]; ! points to LUB 


) 
! Maintenance note: When detecting an error, the best routine to call is 

! BASSSSTOP_I0, since it will print the channel number and file name. 

! However, it should not be called until after the file name and channel 

! number are stored in the LUB and FAB. The best time to call BASS$$STOP_IO 
! is after the RMS SOPEN, since the file name will then be the resultant or 
! expanded name from RMS, which will have defaults merged and logical names 
! translated. Thus, defering recognizing errors until after the RMS SOPEN 
! is worth while. Of course, some errors cannot reasonably be deferred to 
! that point, such as a channel number being out of range, and for these 

i the BAS$SSSTOP routine is used to signal errors. 
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6 Set up condition handler for UNWINDs 

: : 

7 ENABLE 

4 OPEN_HANDLER (UNWIND_ACTION, UNWIND_CCB); 

7 '¢ 

: Initial action is NOP 

4 UNWIND_ACTION = UNWIND_NOP; 

7 i Fetch the channel number from the user. Later we may need the 
4 8 address. 

81 4 CHANNEL = .OPEN_ARG_BLK COPNSL_CHANNEL); 

Hy 0 IF (.OPEN_ARG_BLK COPNSV_CHAN_REF J) 

ope . THEN 

269 : if (.OPEN_ARG_BLK COPNS$V_CHAN_WORD]) 

ane ; CHANNEL = .BLOCK C.CHANNEL, 0, 0, 16, 1) 

590 1 CHANNEL = .BLOCK C.CHANNEL, 0, 0, Z%BPVAL, 1); 

591 1 

236 1 '¢ ; 

2oz \ ; If the channel number is negative or too large, we have a fatal error. 
595 19 

299 31 IF ((. CHANNEL LSS LUBSK_LUN_MIN) OR (. CHANNEL GTR LUBSK_LUN_MAX)) THEN BASSSSTOP (BASSK_ILLIO_CHA); 
598 2 '¢ 
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3 «599 1523 ' If the channel number is zero, the OPEN fails. 

: Bot 1368 § 

3 68 12 $ IF (. CHANNEL EQL 0) THEN BASSS$STOP (BASSK_ILLIO_CHA); 

> 604 1528 '¢ 

; on? 1 3 Compute some auxiliary variables which we will need later. 

; 607 1531 NO_MAP_REC SPECIFIED = 0; 

; 608 3 : RSZ = TOPER_ARG_BLK COPNSW_RECORDSIZ); 

: 610 1238 IF (.RSZ EQL 0) 

; 611 1535 bh 

> 612 1238 BEGIN 

: O15 1537 '¢ ; 

>; 614 1538 ! Provide a reasonable default value for the record size, when we 

> 615 1539 ! can determine one. For V2 programs, the MAP size can be used if 

; oie lect no RECORDSIZE was specified. 

; 618 1366 ; IF .OPEN_ARG_BLK COPNSB_CNT] GTR_K_V1_BLK_SIZE AND 

; 619 154 -OPEN_ARG_BLK COPNSW_MAP_SIZE] REQ™O 

: 620 1544 3 HEN 

; 621 1545 3 RSZ = .OPEN_ARG_BLK COPNSW_MAP_SIZE] 

> 62 1546 3 E 

: 62 1547 4 BEGIN 

> 624 1548 4 NO_MAP_REC_SPECIFIED = 1; 

: oe 1333 3 RS7 A es -OPEN_ARG_BLK COPNSB_ORG] FROM OPNSK_ORG_TERMI TO OPNSK_ORG_UNDEF OF 
; 627 1551 5 COPNSK_ORG_TERMI, OPNSK_ORG_SEQUE] : BASSK_DEF_RECLE; 
; 628 135¢ g OPNSK~ORG-VIRTU) : 512; 

: 629 1553 5 INRANGE, OUTRANGE) : 0; 

: 630 1554 4 TES); 

; 631 1555 4 END 

; 632 1556 3 END 

>; 633 1557 2 ELSE 

> 634 1558 2 !¢ ’ . ; 

3; 635 1559 2! For virtual files, round the record size down if necessary to make 
; 636 1560 2! it even. 

3 637 1561 !e 

; 638 1266 

: 639 156 7F (.OPEN_ARG_BLK COPNSB_ORG) EQL OPNSK_ORG_VIRTU) 

; 640 1564 THEN 

3: 641 1565 BEGIN 

3 a6 1366 RSZ = (.RSZ AND -2); 

: 64 156 '¢ 3 ae 

: 644 1568 ! If there is no map, round the record size up to 512 if it is less. 
> 645 1569 ! We don’t want to give an error message here because the file name is 
; 646 1570 ! mot yet set pan the error message needs to include the file name, 
: 647 1571 : $9 we don't .herk here for pou Sap amap less than 

: 648 1226 ! 512 bytes longi iystead a check 1s made after the RMS SOPEN for the 
; 649 157 ' record size still being less than 512 bytes. 

: 839 1398 3 

3 63¢ 1376 IF (.OPEN_ARG_BLK COPNSA_MAP] EQLA 0) THEN RSZ = MAX (.RSZ, 512); 
3 654 1578 § END; 

> 635 1579 
| 
} 
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BKS = .OPEN_ARG_BLK COPNSW_BUCKETSIZ); 
IF (.BKS NEQ 0) 
THEN 


'¢ 
Compute the bucket size in RMS terms 


BKS = (511 + (.BKS*(.RSZ + 
BEGIN 


IF (.OPEN_ARG_BLK COPNSB_RFM] EQL OPNSK_RFM_VARIA) THEN 2 ELSE 0 
END 
+ 
BEGIN 
IF (.OPEN_ARG_BLK COPNSB_ORG] EQL OPNSK_ORG_INDEX) THEN 7 ELSE 1 
END 
)) + 
BEGIN 
IF (.OPEN_ARG_BLK COPNSB_ORG] EQL OPNSK_ORG_INDEX) THEN 15 ELSE 0 
END 
)/512; 
'¢ 
! Compute the block size in RMS terms in case this is a new file on mag tape. 
hha Rize is rounded up to the nearest 4 bytes for compatability with the 
a . 

BLS A... CCCCMAX (1, .OPEN_ARG_BLK COPNSW_BLOCKSIZE])* 


IF (.OPEN_ARG_BLK COPNSB_RFM] EQL OPNSK_RFM_VARIA) THEN .RSZ + 4 ELSE .RSZ 


END 
= ) + 3) AND ( NOT 3)), 20); 


! Allocate the LUB, ISB and RAB if they have not already been 

! allocated for this LUN. Push down if there is already an 1/0 
! statement in progress on another unit. On return, CCB points 
: to the current control block. 


BASSSCB_PUSH (. CHANNEL, LUBSK_LUN_MIN); 
Arrange to POP the (CB if we get an error. 


UNWIND _CCB = .CCB; 
UNWIND _ACTION = UNWIND_POP; 


'¢ 

! If the LUN is already open, close it. The call to BASSSSTOP_10 here 
' will print the former file name (that is, the name of the file that 
could not be closed). 
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| BASSOPEN 16-Sep-1984 00:52:31 AX-11 Bliss-32 V4.0-742 
(1-1 eit 1e- 308-1 Sac 09 :38:3 BASRTL.SRCJBASOPEN.B32;91 
is 713 1637 3 IF (.CCB CLUBSV_OPENED]) 
3) (716 1638 THEN 
He: et rong 
: a5 1641 IF ( NOT OTS$SCLOSE_FIiE ()) THEN BAS$S$STOP_IO (BASSK_IOERR_REC); 
Re EG, 
: + 
: 720 1644 ' We must arep R11 and pick it back up so that the CLOSE can complete. 
s fel 1645 ! Otherwise the CLOSE will ‘hang fire’ until the recursive I/0 is 
Be ae tReet 
: 724 1648 3 BASSS$CB_POP ( 
3 tS? 1663 BASSS(B_ PUSH C * CHANNEL, LUBSK_LUN_MIN); 
: re? 1651 i “were which CCB to unwind in case of future errors 
: 729 1888 UNWIND_CCB = .CCB; 
: 730 1654 § END; 
mo Web. 
: tag 1657 $ i If the channel is still open (possibly due to recursive 1/0), fail. 
> 734 1658 2! Also fail if there is a FAB associated with the LUB, which means that 
s 755 1659 2 ! the FORTRAN compatability routines have been called to provide implicit 
; 736 1660 2 ! inputs to OPEN. Again, the call to BASS$STOP_IO will print the former 
evar 1661 2 ! file name. 
: $36 166s 3 
: a ieee 4 (.CCB CLUBSV_OPENED] OR .CCB FLUBSV_DEALLOC] OR (.CCB CLUBSA_FAB] NEQA 0)) 
3 (74 1666 2 BASS$STOP_IO (BAS$K_IO_CHAALR); 
2 aie 
> 745 1669 2 ! Make sure the file name fields are set up in case of an error. 
> 746 1670 2 ! From here to the RMS SOPEN, a call to BA $$STOP_10 will print the name 
: a7 1671 2 i of this file, as supplied in the call. 
: 749 167 : : FILE _NAME coe 7 ARG BLK COPNST_FILE eee 
> 750 1674 : CCB LUBSA_RSN) = NAME_DESC COSCSA POINTERI; 
3 eh Hy 3 sd LUBSB_ “Ret = mine - PILE ~NAME DESC tosc$u _LENGTH), 255); 
: 75 1677 5 i Sign out the logical unit number, so an AST won't try to open it. 
ia rte 85 
: 756 1680 IF ( NOT OTSSSTAKE_LUN (CHANNEL)) THEN BAS$S$STOP_IO (BASS$K_IO_CHAALR); 
Bo BS. 
: 44 1688 i _Now that we are sure the CCB is ours, if we get an error, deallocate it. 
: 761 1685 hes " _ UNWIND_ACTION = UNWIND_DEALLOC; 
; 762 1686 2 !'<BLF/PAGES 


—_——— _ encanta san . 
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| BASSOPEN 1bese -1984 7:52:31 AX-11 Bliss-32 V4.0-742 Page 1 
An 1o=ge8- 138i 90:28:3) BASRTL. RCIBASOPEN.B32;91 . (5 
|; 764 1687 '+ 
a oe? 1058 Set up the FAB. The fields are set up in alphabetical order. 

: 767 1690 2@ FAB = FAB_BLOCK; 

>; 768 1691 SFAB_INIT (FAB = .FAB, FAC = ); 

; 69 1698 FAB CFABSL_ALQ] = .OPEN_ARG_BLK COPNSL_FILESIZE]; ! Length of file in blocks 

3 aA 1694 IF _((.OPEN_ARG_BLK COPNSB_ORG] EQL OPNSK_ORG_RELAT) OR (.OPEN_ARG_BLK COPNSB_ORG] EQL OPNS$K_ORG_INDEX)) 
; os 1696 FAB CFABSB_BKS] = MIN (255, .BKS); ' number of blocks in each bucket 

: 775 1698 IF ( NOT ((. OPEN_ARG mi COPNS$B a? EQL OPNSK_ORG_RELAT) ! 

: re 1928 5 = (.OPEN_ARG_BLR COPNSB_ORG) EQL OPNSK_ORG_INDEX))) 

; 078 1701 : FAB CFABS$W_BLS] = .BLS; ! mag tape block size 

; 1708 3 2 FAB CFABSW_DEQ) = .OPEN_ARG_BLK COPNSW_EXTENDSIZ]; ! blocks to add when extending file 
3 ree 1702 § ; Store pointer to default file name, as specified by the user. 

: 784 1707 2°  FILE_NAME_DESC = .OPEN_ARG_BLK COPNST_DEFAULTNAI; 

; 786 1709 ‘ IF (.FILE_NAME_DESC NEQ 0) 

UE Me 

: 789 ar 3 FAB CFABSL_DNA] = .FILE_NAME_DESC CDSCSA_POINTER); 

: 790 1713 3 FAB CFABSB-DNS) = MIN (255, -FILE_NAME_DESC CDSC$W_LENGTH)); 

; 791 1714 2 END; 

2: eae 

: '¢ 

; 794 1717 2 ! Set the FAC field. 

Pepe it te 

> 797 1720 2 SELECT (.OPEN_ARG_BLK COPNSB_ACCESS]) OF 

: 396 1752 § ht 

: 800 1723 : COPNSK_ACC_DEFAU, OPNSK_ACC_MODIF) : 

: oot sree ¢ FAB CFABSV_DELJ = 1; ' allow deletion of records 

; 803 1726 2 COPNSK_ACC_DEFAU, OPNSK_ACC_READ, OPNSK_ACC_MODIF, OPNSK_ACC_SCRAT) : 

3 4 444 $ FAB CFABSV_GET) = 13 ' aTlow reading records 

: 806 1729 2 COPNSK_ACC_DEFAU, OPNSK_ACC_WRITE, OPNSK_ACC_MODIF, OPNSK_ACC_SCRAT, OPNSK_ACC_APPEN] : 
3 Bor 1730 $ FAB CFABSV_PUT) = 1; T aiTow writing records 

: 809 1738 5 COPNSK_ACC_SCRAT) : 

: 319 73 FAB CFABSV_TRN) = 1; ! allow truncate (scratch) 

; 812 1735 § COPNSK_ACC_DEFAU, OPNSK_ACC_MODIF, OPNSK_ACC_SCRAT] : 

: HF, 1736 FAB CFAB$V_UPD) = 1: T allow updating records 

: 815 1738 COTHERWISE) : 

: 816 1739 BASS$STOP_IO (BAS$K_PROLOSSOR); 

; 817 1740 TES; 

Soe 

; '¢ 

; 820 1703 ! Store pointer to file name, as specified by the user. 


co 
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1-113 14-Sep-1984 11:55:24 BASRTL.SRCJBASOPEN.B32;91 
; ge) 1744 \- 
3 ¢ § 1745 FILE_NAME DESC = .OPEN_ARG_BLK COPNST_FILE_ SPEC] 
> 82 1746 FAB FFABSC_ENA = .FILE_NAME_DESC COSCSA_POINTER); 
; Bee ee y FAB CFABSB_FNS] = MIN (255, TFILE_NAME_DESC COSC$W_LENGTH)); 
: 826 1749 2 | Set up the FOP field. 
BP Bs 
; 829 123¢ i If the user specified a file size but did not say CONTIGUOUS, do a 
; 830 175 ' “best effort’’ attempt to get contiguous space. This is compatable 
; Bs 1754 ' with FORTRAN. 
; os 1755 ! Note: this code has been disabled pending review. Because a search 
; 835 1726 ' is made for the requested space, this could cause a performance 
> 834 175 ! problem. 
: 83 61985 8 xe 
: See 3 1769 2 if ((.OPEN_ARG_BLK COPNSL_FILESIZE] NEQ 0) AND ( NOT .OPEN_ARG_BLK COPNS$V_CONTIGUOU))) 
: 839 C 1768 § FAB CFABSV_CBT) = 1; 
ie bh 
> 84 1765 5 i If the user specified neither FOR INPUT nor FOR OUTPUT, then set 
3; «84 1766 2 ! the CIF bit, so that the S$CREATE yb ten service will use an 
> 844 1767 2 ! existing file if one is present. (Otherwise it will create a new 
> 845 1768 § ! file, as usual.) 
Dee 8 he 
> 848 1771 : IF ( NOT (.OPEN_ARG_BLK COPNSV_FOR_INPUT] OR .OPEN_ARG_BLK COPNSV_FOR_OUTPUJ)) THEN FAB CFABSV_CIF] = 1; 
: 56 1798 3 86 
: 851 1774 2! Set the ‘contiguous best try‘ flag if the user said CONTIGUOUS. 
; £26 1775 § ‘ ( Perhaps we should set CTG? ) 
Be i gh 
: 855 1778 2 IF (.OPEN_ARG_BLK COPNSV_CONTIGUOUJ) THEN FAB CFABS$V_CBT) = 1; 
BB Bl 
> 858 1781 2! Set “deferred write’ unless the ALLOW option implies sharing which 
; 859 17ee § ! does not permit it. 
Bock ge 
> 862 1785 4 IF ((.OPEN_ARG BLK COPNSB_ALLOW] NEQ OPNSK_ALL_WRITE) AND (.OPEN_ARG_BLK COPNSB_ALLOW] NEQ 
; Hrd 1736 3 OPNSK_ALL_MODIF)) 
; 865 1788 FAB CFABSV_DFW) = 1; 
BE. 
: 868 1791 ' If the user did not say APPEND, set the NEF flag to prevent 
; 869 16 ! positioning a mag tape to end-of-file on open. 
: BM 1994 3 
: 87 1795 IF (.OPEN_ARG_BLK COPNSB_ACCESS] NEQ OPNSK_ACC_APPEN) THEN FAB CFABSV_NEF] = 1; 
Mm BFS. 
: 875 1798 If NOREWIND is not specified, cause the tape to rewind on open. 
: 87 1800 2- 
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; Ha 190) IF ( NOT .OPEN_ARG__LK COPNSV_NO_REWIND]) THEN FAB CFABSV_RWO] = 1; 

; 880 1808 1? 

> 881 1804 : In terminal format files, only sequential operations are allowed. 

; 88 1805 : Tell RMS that we will only be doing sequential operations in case 

; #88 1806 ! it can gain some efficiency by knowing this. 

Be in i* 

; B86 1809 IF (.OPEN_ARG_BLK COPNSB_ORG] EQL OPNSK_ORG_TERMI) THEN FAB CFAB$V_SQO) = 1; 
; 888 1811 to " 

; 889 alg : If the user said ‘FOR OUTPUT’, set the SUP bit so that the SCREATE will 
: 890 181 : supercede any existing file. Note that this will happen only if a version 
; 891 1814 ! number is specified, since the default for the version number on $CREATE is 
; # 1815 ' the next higher number. 

; 89 1816 2 !- 

> 894 1817 2 

; 895 1818 ‘ IF (.OPEN_ARG_BLK COPNSV_FOR_OUTPUJ) THEN FAB CFABSV_SUP] = 1; 

> 896 1819 

3 897 1820 2 !+ 

; 898 1821 2 ! If the user said TEMPORARY, mark the file as ‘‘temporary, delete when 

; 899 18se 2 ! closed’. 

; 900 1823 2 !- 

; 901 1824 

é 4 13s? IF (.OPEN_ARG_BLK COPNSV_TEMPORARY]) THEN FAB CFABSV_TMD] = 1; 

; 904 1827 2 FAB CFABSB_FSZ] = .OPEN_ARG_BLK COPNS$B_FSZ]; 

; 905 1828 2 FAB CFASSW_MRS) = .RSZ; 

> 906 1829 § 

; 907 1830 + 

: 908 1831 2 ! Set up ORG field. 

33 WR EE 

; 911 1834 2 CASE (.OPEN_ARG_BLK COPNSB_ORG]) FROM OPNSK_ORG_TERMI TO OPNSK_ORG_UNDEF OF 
; 912 1835 2 SET 

> 913 1836 § : 

: 914 1837 COPNSK_ORG_TERMI) : ! Terminal format file 

: ai? ses § FAB CFABSB_ORG) = FABSC_SEQ; 

; 917 1840 COPNSK_ORG_VIRTU] : ! Virtual array file 

s 4 et FAB CFABS$B_ORG) = FABSC_SEQ; 

; 920 1863 COPNSK_ORG_SEQUE] : ' Sequential file 

: $93 ieee FAB CFABSB_ORG] = FABSC_SEQ; 

; ¥ 5 1846 COPNSK_ORG_RELAT) : ' Relative file 

3 ase H+ of FAB CFABSB_ORG) = FABSC_REL; 

; 358 1869 COPNSK_ORG_INDEX) : ! Indexed file 

; 44 1330 FAB CFABSB_ORG) = FABSC_IDX; 

: 929 1858 COPNSK_ORG_UNDEF) : ! Unspecified organization 
3; 930 185 FAB CFABSB_ORG) = FABSC_SEQ; 

; «931 1o38 

; 236 1855 COUTRANGE) : 

; 93 1826 BASSSSTOP_IO (BAS$K_PROLOSSOR); 

3 934 185 TES; 
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; 935 1858 

; 936 1889 + 

oor 1860 : Set up RAT field. PRN will be set after OPEN if this is a terminal device and a 
; 938 1861 !' terminal format file with default record attributes. 

; 939 186¢ te 

: 940 186 

3 ah 1008 IF (.OPEN_ARG_BLK COPNSV_NOSPAN]) THEN FAB CFABS$V_BLK) = 1; 

7 94 1866 CASE .OPEN_ARG_BLK COPNSB_RAT] FROM OPNSK_RAT_DEFAU TO OPNSK_RAT_ANY OF 

: 944 1867 SET 

>; 945 1868 

; 308 136? COPNSK_RAT_DEFAU, OPNSK_RAT_ANY] : 

3 oe8 190) IF (.OPEN_ARG_BLK COPNSB_ORG] NEQ OPNSK_ORG_VIRTU) THEN FAB CFAB$V_CRI = 1; 
; 950 1838 COPNSK_RAT_FORTR] : 

; «951 1874 2 FAB CFABSV_FIN] = 1; 

; 952 1875 

>; 953 1876 COPNSK_RAT_CRLF] : 

3; 954 1877 FAB CFABSV_CR) = 1; 

; #955 1878 

; 956 1879 COPNSK_RAT_NONE] : 

: 957 1880 BEGIN 

; 958 1881 3 

: 93) 1882 § END; 

; 960 1883 

: 961 1884 2 COPNSK_RAT_PRINT]) : 

> 962 1885 2 FAB CFABSV_PRN) = 1; 

; 963 1886 § 

3; 964 1887 COUTRANGE) : 

3; 965 1888 BAS$$STOP_I0 (BAS$K_PROLOSSOR); 

: 966 1889 TES; 

: 967 1890 

; 968 1891 '¢ 

; 969 189 ' Set up the RFM field. 

; 970 1893 2 !- 

3; 971 1894 2 

3 972 1895 2 CASE (.OPEN_ARG_BLK COPNSB_RFMJ) FROM OPNSK_RFM_DEFAU TO OPNSK_RFM_STREA OF 

; 973 1896 2 SET 

: 974 1897 2 ‘ 

; 975 1898 COPNSK_RFM_DEFAU) : ' Default to variable unless VIRTUAL 
; 976 1899 FAB CFABSB_RFM) = 

nS ong 

3 Ag 1308 ; IF (.OPEN_ARG_BLK COPNSB_ORG] EQL OPNSK_ORG_VIRTU) THEN FABSC_FIX ELSE FABSC_VAR 
; «981 1904 END; 

; 1905 

; 98 1906 COPNSK_RFM_FIXED) : : 

: 984 Hb FAB CFABSB_RFM) = FABSC_FIX; ! fixed-length record format 

3 986 1909 COPNSK_RFM_VARIA) : 

: 987 1919 FAB CFABSB_RFM) = FABSC_VAR; ' variable-length record format 

; 989 bat COPNSK_RFM_VFC) g . 

; 390 1913 FAB CFABSB_RFM) = FABSC_VFC; ' variable-length with fixed control record format 
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99 COPNSK_RFM_STREA, OUTRANGE]) : 

99 BASSS$STOP_I0 (BAS$K_PROLOSSOR) ; 

o3e 1es:° 

238 - FAB CFABSB_RTV] = .OPEN_ARG_BLK COPNSB_WINDOWSIZ]; 

998 i Set the SHR field. Note that no bits are set in the default case, which causes 
999 ' RMS to default ty based on how the file is to be used: read sharing if we 
poe ; are only reading the file, no sharing otherwise. 

00 

O08 SELECT (.OPEN_ARG_BLK COPNSB_ALLOWJ) OF 

one SET 


° 
& 


COPNSK_ALL_MODIF] : 


00 FAB CFABSV_ SHRDEL) = ' allow sharers to delete 
aber y ALL_READ oeeat ~AUt rOOIt) 
FABSV_ SHR ' allow sharers to read 

COPNSK_ALL_NONE, OPNSK ALL pe 

FAB EFRBSY _NILJ = 7; ! forbid sharing 
COPNSK_ALL_MODIF, a -ALL_WRITE] : 

FAB CFABSV_ SARPUT] = 1; ' allow sharers to write 
COPNSK_ALL_MODIF] : 

FAB EF ABSv_ SHRUPD] = ' allow sharers to update 


COPE Ah Per me? : use RMS defaults: don't set FABSB_SHR field 


COTHERWISE) : 
7? BASS$$STOP_10 (BASS$K_PROLOSSOR); 
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'¢ 
7 If organization is indexed then set FABSV_MSE unconditionally. 


IF .OPEN_ARG_BLK COPNSB_ORG] EQL OPNSK_ORG_INDEX THEN FAB CFABSV_MSE] = 
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14 
Set up the LUB. 


ooo 


WIG 


S33 


: 1037 1959 

1089 136) 

: 1940 196¢ |. CCB CLUBSA_FAB] = .FAB; ! store pointer to FAB in LUB 
; 136 13e¢ ! Store pointer to user-supplied file name in LUB for error processing 

5 1044 1966 "  ¢¢B FLUBSA_RSN = .FAB CFABSL_FNA); 

; 1045 1967 ,, CB CLUBSB=RSL] = .FAB CFABSB_FNS); 

> 1047 1969 2 | Set the READ ONLY, SCRATCH and APPEND bits in the LUB based on the 

; 1048 1970 ' access. If READ ONLY is set, set OLD_FILE, since there is no point 

3 1049 1971 ! in creating a file which can only be fread. 

et ie i 

; 105¢ 1974 CASE (.OPEN_ARG_BLK COPNSB_ACCESS]) FROM OPNSK_ACC_DEFAU TO OPNSK_ACC_APPEN OF 
.| ns - 

: 1055 1977 COPNSK_ACC_DEFAU, OPNSK_ACC_MODIF, OPNSK_ACC_WRITE) : 

: 1056 1978 BEGIN T set none of the three bits 
3; 1057 1979 CCB CLUBSV_READ_ONLY] = 0; 

3; 1058 1980 CCB CLUB$V-SCRATCH) = 0; 

3; 1059 1981 CCB CLUBSV_APPEND) = 0; 

 1oet 1988 3 as: 

> 1062 1984 é COPNSK_ACC_READ] : 

: 1063 1985 BEGIN ' set READ_ONLY 

3 1064 1986 3 CCB CLUBSV_OLD_ FILE] = 1; ! Do not create file 

> 1065 1987 3 CCB CLUBSV“REAB_ONLY) = |; 

3; 1066 1988 CCB CLUB$V_SCRATCH) = 0; 

> 1067 1989 3 CCB CLUBSV“APPEND] = 0; 

| oe a 

: 1070 199@ ; COPNSK_ACC_SCRAT) : 

3; 1071 199 BEGIN ' set SCRATCH 

3; 1072 1994 3 CCB CLUBSV_READ_ONLY) = 0; 

3; 1073 1995 3 ccB LUBSV_ SCRATCH] s 1; 

3: 1074 1996 CCB CLUBSV_APPEND) = 0; 

: 1bp8 1998 3 ~ 

: 1077 1999 COPNSK_ACC_APPEN) : Pease 
3: 1078 2000 BEGIN ' set APPEND. It will be cleared if the file is NEW 
3; 1079 2001 CCB CLUBSV_READ_ONLY] = 0; 

; 1080 00 CCB CLUBSV-SCRATCH) = 0; 

; 1081 00 CCB CLUBSV_APPEND) = 1; 

3 1088 004 2 END; 

3; 108 $003 TES; 

1 BBE 

: 1996 2008 : Set the ‘not sequential’’ flag in the LUB based on the file organization. 

: 1088 he 

> 1089 1 CASE (.OPEN_ARG_BLK COPNSB_ORG]) FROM OPNSK_ORG_TERMI TO OPNSK_ORG_UNDEF OF 
: 1090 ; SET 

s 1 

+ 4 

3; 1 2015 


Cooooo°o 
od ad ed oe ed 


COPNSK_ORG TERMI, OPNSK_ORG_SEQUE) : 
CCB ELOBSV, NOTSEQORGS 20; 


So 
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COPNSK_ORG_RELAT, OPNSK ORG_ INDEX, OPNSK_ORG_VIRTU, OPNSK_ORG_UNDEF] : 
es. CLOBSV_NOTSEQORG) ="1; 


° 
14 


: Set the ‘formatted’ and ‘unformatted’ bits in the LUB. 
These bits are used only by FORTRAN 1/0 statements. 


CASE (OPENLARG_BLK COPNSB_ORG]) FROM OPNSK_ORG TERMI TO OPNSK_ORG_UNDEF OF 


COPNSK_ORG_ TERMI, OPNSK_ORG_SEQUE, OPNSK_ORG_RELAT, OPNSK_ORG_INDEX] : 
CCB CLOBSV_FORMATTED) ="1; 


COPNSK_ORG 


$ 
VIRTU, OPNSK_ORG_UNDEF] : 
ccB CLOe$sv 


 UNFORMAT] = T; 


1+ 
Set the ‘fixed’ flag in the LUB. 


IF (.FAB CFABSB_RFM] EQL FABSC_FIX) THEN CCB CLUBSV_FIXED] = 1; 


‘+ 
: Set the ‘old file’ flag in the LUB. | 

eg also be set after the SOPEN if the file turns out to already 
! exist. 

Ve 


IF (.OPEN_ARG_BLK COPNSV_FOR_INPUTJ) THEN CCB CLUBSV_OLD_FILE] = 1; 


'¢ 
Set the ‘direct’ flag in the LUB. This is used only by FORTRAN I/0. 


CASE (-OPEN_ARG_BLK COPNSB_ORG]) FROM OPNSK_ORG_TERMI TO OPNSK_ORG_UNDEF OF 
COPNSK ORG TERMI, OPNSK_ORG_SEQUE, OPNSK ORG_RELAT, OPNSK_ORG_INDEX) : 


CCB CLOBS$v_DiRECT) = 0; T not direct access 


COPNSK_ORG_VIRTU, OPNSK_ORG_UNDEF) : 
= CCB CLOBSV_DirECT) = 1; 


! direct access. Assigning UNDEF here is arbitrary. 


'¢ 
Set up the right margin and default right margin. 


CASE _( -OPEN_ARG_BLK COPNSB_ORG]) FROM OPNSK_ORG_TERMI TO OPNSK_ORG_UNDEF OF 
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COPNSK_ORG_TERMI) : 
BEGIN 
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4 
: Terminal format file. We assume that this will be a disk file. If it turns out 
to be a terminal, the margin will be reset to “infinite’’ after the OPEN. 


CCB CLUBSW_D_MARGIN] = 
BEGIN 


IF (.OPEN_ARG_BLK COPNSW_RECORDSIZ] NEQ 0) 


-OPEN_ARG_BLK COPNSW_RECORDSIZ] 

ELSE 
i for V2 programs, use the MAP size if it was specified. 
} (and there was no recordsize) 


IF ( (.OPEN_ARG_BLK COPNSB_CNT] GTR_K_V1_BLK_SIZE) AND 
-OPEN_ARG BLK COPNSW-MAP si263 NEQ™O) J 

THEN .OPEN_ARG BLK COPNSW_MAP_SIZE 

ELSE LUBSK_D_MARGIN 


PAEAPAEMAMNIIN IVI 
WN OO DOONOUS Ww 


END; 
CCB CLUBSW_R_MARGIN] 
5ce LUBSV_NOMARGINJ 


.CCB CLUBS$W_D_MARGIN); 


CINRANGE) : 
as BEGIN 
i This is not a terminal format file. The er is only important for sequential files, 
so we will set up the margin for sequential files. 


CCB CLUB$W_D_MARGIN] = 
BEGIN 


090909 09 0909 SIN NINN NINN NSO O 


OOO O0@WMWO 


IF (.OPEN_ARG_BLK COPNSW_RECORDSIZ) NEQ 0) 
_OPENLARG_BLK COPNSU_RECORDSIZ3 


'¢ 


i for v2 programs, use the MAP size if it was specified. 
(and there was no recordsize) 


ELS 


ee ee Dc ee ce ce DD cD ce ce ce ce Dc cD el ee ee ce ed ed oe 


gs BAS$S$STOP_I10 (BASS$K_PROLOSSOR) ; 


ee ee ee ec ee a ee ee ce ee mc em a ce ee el ee ee ee a ed ee ed ed ed ed 


ee a ee ee et ee ed aed ed ed ad ad ed ad = OO 
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5 IF ( (.OPEN_ARG_BLK COPNSB_CNT] GTR_K_V1_BLK_SIZE) AND 
6 -OPEN-ARG BLK COPNSW” MAP $125) NEQ™O) J 
7? THEN .OPEN_ARG BLK COPNSW_MAP_SIZE 

196 8 ELSE LUBSK_D_MARGIN 

197 9 

198 0 END; 

199 1 CCB FLUBSW_R MARGIN] = 0; 

$00 ; CCB CLUBSV-NOMARGIN] = 1; 

i 

20 5 COUTRANGE) : 


ooo 
Now 


+ 
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12-86-1382 99:38:3) BASRTL. RC IBASOPEN.B32;91 
' Set a flag in the LUB if this file was opened with keys. This 
is important for processing indexed files. 
s CCB CLUBSV_KEYED] = (ACTUALCOUNT () GEQ 2); 


; Set a flag in the LUB if this is a multi-stream connect. 


BASSOPEN 


= {-OPER_ARG BLK COPNSW_CONNECT] NEQ 0) 
neo CLUBSV_M_STREAM] = 1 
CCB CLUBSV_M_STREAM] = 0; 
‘+ 
! Set the terminal format file bit in the LUB if this is a terminal 
format file. This is used to bias RECOUNT. 
IF (.OPEN_ARG_BLK COPNSB_ORG] EQL OPNSK_ORG_TERMI) THEN CCB CLUBSV_TERM_FOR] = 1; 


! <BLF /PAGE> 
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14 
Set up the RAB. 


wre 


CCB CRAB$B_BID] = RABSC_BID; ! this is a RAB 
CCB LRABSB_BLN) = RABSC_BLN; ' Length of a RAB 
CCB LRABSL_FABJ = .FAB; ! pointer to File Access Block 


i Set up the key buffer and size fields. If this is a terminal device 
1 these will be overwritten by the prompt buffer and size fields, 
but this is OK, since you cannot do keyed access to a terminal device. 


CCB CLUBSL_LOG_RECNOJ; 


POPPONMINIPEPEPoPofonornononoforofurnofnonofrerorunonrorory 


'¢ 
: Always turn off Locate mode. This is done because GETs of variable length 
: records are to null fill the remainder of the buffer. This cannot be done 
if the data is in an RMS buffer in system space. 


|, 668 CRABSV_LOCI = 0; 


i Don't truncate the file on a PUT to its middle; give an error message 
! instead. 


3 3 1 

3 7 1 ‘ 

5 y 154 

3 7 155 

3 les0 128 

; 1236 15 

: 1237 158 

>; 1238 159 

; 1239 160 

wp Be 

: 1 4g 188 CCB CRABSL_KBF) = 

> 124 164 CCB CRABSB-KSZ] = 

; 1 re 165 CCB CRABSB-MBF] = .OPEN_ARG_BLK COPNSB_MULTIBUFFJ; ! number of buffers 
; 1 ré] 4 IF (.OPEN_ARG_BLK COPNSB_FSZ] NEQ 0) THEN CCB CRABSL_RHB) = -OPEN_ARG_BLK COPNSA_VFCJ; 
> 1248 169 2 '+ 

3 1249 170 ' Set up the ROP field. 

: 1250 2171 !- 

Be BRB. 

: : 35 size 2 for V2 programs, enable manual record locking if specified. 

; ’ 22 $178 5 : i (-OPEN_ARG_BLK COPNSB_CNT] GTR K_V1_BLK_SIZE) 

3 1257 2178 g IF (.OPEN_ARG_BLK COPNSV_UNLOCK] NEQ 0) 

3 1258 2179 2 THEN 

3: 1259 2180 3 BEGIN 

: 1501 S182 3 r 

: \¢66 2183 ; i if this is a sequential file, and the recordsize is not 512, 

; 1$ez sige ; manual record locking is not allowed; otherwise, it is. 

3 1265 2186 4 IF (.OPEN_ARG_BLK COPNSB_ORG] EQL OPNSK_ORG_SEQUE AND | 
3; 1266 2187 4 -OPEN_ARG BLK COPNSW-RECORDSIZ) NEQ™512) 
; +t sise 3 THEN BASS$$STOP_10 (BAS$K_REQRECS1Z) 

> 1269 190 ; ELSE CCB CRABSV_ULK) = 1; 

3; 1270 191 ! enable manual record locking 

3 1271 $136 2 END; 

Be RES. 

; igre 13? If we are to append to the file, position to EOF when opening it. 

3 1276 197 2. 

; HF 444 Hb 2 IF (.OPEN_ARG_BLK COPNSB_ACCESS] EQL OPNSK_ACC_APPEN) THEN CCB CRABSV_EOF] = 1; 
3 1279 2200 

3: 1280 01 

: 1281 soe 

31 Ht 20 

3; 128 204 

3 1284 $33 

3: 1285 BS 

3: 1286 20 

3; 1287 208 
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FAB-CFABSL_NAM] = NAM_BLOCK? 


+ 
Initialize the local FHC XAB and point the FAB to it. This is 
used to get the size of the longest record in an old file, so 
that the buffer size can be defaulted properly. f 
Also initialize the SUMMARY XAB and add it into the XAB chain. 
This will be used to set total number of keys for indexed files. 


SXABFHC_INIT (XAB = XABFHC, NXT = XABSUM); 
SXABSUM_INIT (XAB_= XABSUM); 


8 3 
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1. 8 107808= 138 09:38:34 EBASRTL-SRe BASOPEN.B32;91 : 3 
88 0 je 
34 : ‘ CCB CRABSV_TPT] = 0; 
91 1 i Don't convert PUT to UPDATE except on VIRTUAL files. If the user wants 
4 1 ' to do an UPDATE to any other kind of file, he must issue an explicit 
at, : UPDATE statement. 
$3? ; CCB CRABSV_UIF] = (.OPEN_ARG_BLK COPNSB_ORG] EQL OPNSK_ORG_VIRTU); 
97 1 Initialize the local NAM block and point the FAB to it so that 
98 1 : RMS will return the full name of the file being accessed. This 
+4 will improve error messages. 
$0) SNAM_INIT (NAM = NAM_BLOCK); 
0 NAM_BLOCK pues ae = NAM_BLOCK wanes ESA) = FILE NAME; 
303 NAMBLOCK CNAM$B_RSS) = NAM_BLOCK CNAMSB_ESS) = NAMST_MAXRSS; 
305 
3 
3 


! make sure SUM is end of chain 
om ! Link FAB to XAB 


! Initialize the KEY XABs if any keys are provided in this call to OPEN. 


IF (ACTUALCOUNT () GEQ 2) 
THEN 
BEGIN 


LOCAL 
KEY_PTR : REF BLOCK C, BYTE] FIELD (OPNSKEY_BLOCK), 
KABREY : REF SXABKEY_DECL; 


'¢ 

! The keys are arranged in order by yf number. : 

! They are allocated in reverse order because RMS-32 requires them to 
: be chained in forward order. 
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DECR KEYNO FROM .KEY. INFO_BLK CKEYHSB_KEYNUM] - 1 TO 0 DO 
KEY PTR = (.KEYNO* KEY, INFO_BLE CKEYHSB_LEN]) + KEYHSK_LENGTH * .KEY_INFO_BLK; 
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LOCAL 
GET_VM_STATUS; 


GET_VM_STATUS = LIBSGET_VM (ZREF (XABSC_KEYLEN), XABKEY); 
IF ( NOT .GET_VM_STATUS) THEN BASSSSTOP_IO (BASSK_MAXMEMEXC) ; 
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| ez. 
BASSOPEN Jen3e0~ 138% 90: 38:3) rest Bliss-32 V4.0-742 
1-11 14-Sep-1984 11:55:24 BASRTL.SRC JBASOPER .832;91 
_* 1 5 6 5 
is 1 re 67 4 END; 
(3 (134 68 4 SXABKEY_INIT (XAB = .XABKEY); 
3 1348 69 4& I+ 
3 : 4 4 : } Fill in the key XAB from the parameter. 
; 1351 ie 4 XABKEY apr tags = .KEYNO; : ney of reference 
4 38 73 4 XABKEY CXABS$W-POSO) = .KEY_PTR CKEYSW_OFFSETI; Position in record 
3; 135 74 4 XABKEY CXAB$B_SIZ0] = .KEY_PTR CKEYSB_LENJ; ! Total key Length 
: 1328 75 4 ! if NOT segmented; 
3 1355 76 4 ! otherwise Length of 
> 1356 77 4 ! first segment. 
3 1357 78 4 XABKEY CXABSV_CHG) = .KEY_PTR CKEYSV_CHGJ; ! Key can be changed 
3; 1358 444 4 XABKEY CXABSV_DUP] = .KEY_PTR CKEYSV_DUPJ; ! Key can be duplicated 
; 1359 2280 4 
; 1360 2281 4 !+ , 
3; 1361 $so¢ 4 ! also fill in the summary XAB. 
; 1368 2283 4 !- 
> 136 2284 4 XABSUM CXAB$B_NOK] = .KEY_INFO_BLK CKEYHSB_KEYNUM); 
> 1364 2285 4 
3 1365 2286 4 !+ 
: 1366 2287 4 ! The V2 compiler supports segmented keys, the V1 compiler does not. If this 
; Lt ot ssoe : is a V2 program, check for multiple key segments. 
3 1369 2290 5 IF (.OPEN_ARG_BLK COPN$B_CNT] GTR K_V1_BLK_SIZE) 
: 1370 2291 4&4 THEN 
; 1371 $536 5 BEGIN 
: 1372 2293 5 IF .KEY_PTR CKEYSB_NUM_SEG] GTR 0 
> 1373 2294 5 THEN 
3 1374 2295 6 BEGIN 
3 1375 2296 +6 INCR KEY_NUM FROM 1 TO .KEY_PTR CKEYSB_NUM_SEG] DO 
3; 1376 2297 7 BEG! 
: 1377 2298 7 CASE .KEY_NUM FROM 1 TO 7 OF 
: 1378 $638 7? SET 
3; 1379 2300 7 (1): 
; 1380 2301 8 BEGIN 
; 1381 Seng 8 XABKEY CXAB$B_S1Z1] = .KEY_PTR CKEYSB_LEN1); 
> 1382 2303 8 XABKEY CXABSW"POS1] = .KEYTPTR CKEYSW-OFFSET1); 
; 1383 2304 7 END; 
3 1384 2305 7 
3 1385 $306 7 : 
> 1386 2307 8 BEGIN 
3 1387 2308 8 XABKEY CXAB$B_S172] = .KEY_PTR CKEY$B_LEN2); 
; 1388 309 8 XABKEY CXABSW-POS2] = .KEYIPTR CKEYSWLOFFSET2); 
: 1389 310 END; 
3; 1390 311 7 
: 1391 a6 7 (3): 
: 1338 313 8 BEGIN 
3; 139 314 8 XABKEY Healt? = .KEY_PTR CKEY$B_LEN3); 
3 1394 315 : MABKEY CXABSW~POS3] = .KEYTPTR CKEYSW~OFFSET32; 
3 1395 318 END; 
3 1396 317 7 
3 1397 318 7 (4): 
; 1398 319 : BEGIN 
: 1399 320 XABKEY FxABSB_ S174 = .KEY_PTR (KEYSB_LENG): 
> 1400 21 7 KABKEY CXABSW"POS4] = .KEYTPTR CKEYSW-OFFSET4); 
3; 1401 322 END; 
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(5): 
BEGIN 
XABKEY 
XABKEY 
END; 
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(1-11 


-XABKEY CXABSB 


‘Eee XABSB- 


key XABs are placed, in 
ABs on the file. 


M$ CFABSL_XABI; 


: 1459 80 XABSC_STG; 
; 1460 81 S 
3: 1461 gS 
3 re « 83 4 END; 
> 146 84 & t+ 
> 14646 85 4 i define the total key size of this key XAB 
> 1465 86 4 | doesn't set it for us in the case of a $CREA 
3; 1466 87 4 i- 
3 1467 388 5 XABKEY CXABSB_TKS] = ( 
> 1468 $350 5 T 
3: 1469 2390 5 
: 1470 $39! 2 
3 1471 35 
: 1472 2393 5 
: 1473 Sage 5 
> 1474 395 4 
> 1475 2396 4 
: 1476 2397 4& !4 
3 1477 2398 4 | Link this key XAB to the FAB. 
: 1478 2399 4! The XAB chain is set up so that 
3 1479 2400 4 } _in front of any other existing X 
; 1480 2401 4! 
> 1481 2402 4 XABKEY CXABSL NXT] = 
3 1482 2403 4 FAB CFABSL_XAB) = .XABKEY 
> 1483 2404 3 END; 
3; 1484 2405 3 
: 1485 2406 2 END; 
3; 1486 2407 2 
> 1487 2408 2 !<BLF/PAGE> 
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2440 

2441 ' complain later. 

244 != 

244 IF .CCB CLUBSV_M 

2444 

2445 CONNECTED = 

2446 SE 

2447 

2448 CONN 

2449 

2450 

2451 

$e26 BAS$$CB_POP (); 

45 CCB = .OUR_CCB; 
5 2454 
5 $e22 IF (. CONNECTED) 
5 456 
5 2457 IF (.PARENT_IFI 
5 sees 
539 459 IF (.PARENT_ORG 
540 460 
541 461 FAB CFABSW_IF I 
ang ret FAB CFABSW_MRS 
54 46 FAB CFABSB_RAT 
544 464 FAB CFABSB_ 
545 2465 FAB CFAB$B BKS 


F 3 
1oxgeP7 138s 99:28:31 


! Set up the FAB from the parent file if this is a multi-stream connect. 


-CCB CLUBSW7BLS): 


2409 
90 410 
£33 th This is needed because we will not be doing an OPEN. 
3 zui8 
94 414 IF (.CCB CLUBSV_M_STREAM)) 
95 sti? THEN 
416 BEGIN 
9 silt 
9 418 LOCAL 
9 2419 PARENT _IFI, 
50 3 0 PARENT_ORG, 
50 421 PARENT_MRS, 
50 24 ¢ PARENT_RAT, 
50 242 PARENT_RFM, 
50 424 PARENT_BKS, 
50 425 PARENT BLS, 
426 CONNECTED, 
: i 34 OUR_CCB : REF BLOCK C, BYTE]; 
$e OUR_CCB = .CCB; 
430 BASSSCB_PUSH (.OPEN_ARG_BLK COPNSW_CONNECT], LUBSK_LUN_MIN 
5 43) PARENT_TFI = (IF (.0CB CLUBSV_OPENED]) THEN .CCB CCUBS 
5 $38 PARENT_ORG = .CCB CLUBSB_ J; 
43 a -€CB CLUBSWRBUF SIZE) 
434 
435 
436 
437 
438 
439 


: Mark that there may be a connect to this file, for CLOSE. 
! If this is already connected; a child instead of a parent; then remember to 


_STREAM] EQL 1 
1 


ECTED = 0; 
CCB CLUBSV_M_STR_C) = 1; 
END; 


THEN BASS$STOP_IO (BASSK_INVFILOPT); 


EQL 0) THEN BASS$STOP_IO (BASSK_10_CHANOT); 
NEQ LUBSK_ORG_INDEX) THEN BASS$S$STOP_IO (BASS$K_FILATTNOT); 


PARENT_IFI; 
“PARENT -MRS: 


“PARENT-RFM: 
“PARENT ~BKS; 
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>: 1546 46 FAB CFABSW_BLS] = .PARENT_BLS; 
; 1547 46 END; 

1548 468 

1549 469 ! <BLF /PAGE> 


“aastgpen fd “$e0c} 384 90:52:81 


AX-11 Bliss- 
BASRTL.SRCJB 


Aor EW. 7558s 791 


re 


H 3 

| BASSOPEN 16-Sep-1984 00:52:31 AX-11 Bliss-32 V4.0-742 
| 1-113 baer 09 :38:3) EBASRTL-SRCIBASOPEN.832+91 
'; 1951 470 2 !+ 

: 1226 471 ! If the USEROPEN value is non-zero, call the ye og te: procedure 
3; 155 rik ' to do the SOPEN and SCONNECT. It will return an RMS status code 

; 1554 247 ' as its value. Otherwise we do the SOPEN and SCONNECT ourselves. 

; 1555 474 2 ! If we call USEROPEN, set a flag in the LUB to help software support 
; 1556 475 ! if they get an SPR. 

3 1507 47 le 

; 1558 47 

3 1559 478 IF (.OPEN_ARG_BLK COPNSA_USEROPEN] NEQA 0) 

; 1560 2479 THEN 

3; 1561 480 BEGIN 

; 1206 481 CCB CLUBSV_USEROPEN) = 1; 

3; 156 4 OPEN STATUS = (.OPEN_ARG BLK COPNSA_USEROPEN]) (.FAB, .CCB, %REF (.CCB CLUBSW_LUN))); 
: 1564 48 CONNECT_STATUS = SSS$_NORMAL; 

>; 1565 484 

: 1566 2485 4 IF ( NOT .OPEN_STATUS) 

: 1567 2486 3 THEN 

3; 1568 2487 4 BEGIN 

: 1569 2488 4 I+ 

; 1570 2489 4 ! Try to construct the correct values for OPEN_STATUS and CONNECT_STATUS. 
3; 1571 2490 4 !- 

: 1306 2491 4 

3; 157 2492 5 IF (.FAB CFABSL_STS)) 

> 1574 2493 4 THEN 

3; 1575 2494 5 BEGIN 

3 1576 2495 5 !+ 

3; 1577 2496 5 ! The SOPEN was OK, how about the SCONNECT. 

: 1578 2497 5 !- 

; 1579 2498 5 

3; 1580 2499 6 IF ( NOT .CCB CRABSL_STS]) 

3; 1581 2500 5 

: 1582 2501 6 BEGIN 

; 1583 $206 6 !+ , 

3; 1584 2503 6 ! The SOPEN succeeded but the SCONNECT failed. 

>; 1585 2504 6 !- 

3; 1586 2505 6 OPEN_STATUS = .FAB CFABS$L_STS); 

> 1587 2506 6 CONNECT_STATUS = .CCB CRABSL_STS); 

: 1588 2507 6 END 

: 1589 2508 5 ELSE 

3; 1590 2509 5 !+ 

3 133) $219 ; Both the RMS values look ok, just signal the error. 

: 1593 312 5 LIBSSTOP (.OPEN_STATUS); 

3: 1594 513 5 

3; 1595 514 4 END; 

3 1596 515 4 

3; 1597 516 END; 

: 1598 517 

3; 1599 518 END 

: 1600 519 ELSE 

; 1601 520 BEGIN 

; ioe 521 1 

; 160 5 § ! Not USEROPEN. If an old file is oapi Sc ithy wanted 

: 1604 5 ! (user said FOR INPUT) do a SOPEN. Otherwise do a SCREATE. 

: son ; : However, if this is just a CONNECT, do a SDISPLAY to set up the XABs. 
: 1809 526 
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_BASSOPEN 1b-sep-1984 00:52:31 AX-11 Bliss-32 V4.0-742 
ety 14-5 aa 99:38:34 UBASRTL. SRC IBASOPEN.852°91 
IF (.CCB CLUBSV_M_STREAM)) 

OPEN_STATUS = SDISPLAY (FAB = .FAB) 


ELSE 
BEGIN 


'¢ 
' check for a terminal format file on a terminal device, 
! and change to PRN format if so. 
} This is so that the terminal is forcible. 
: OPEN_STATUS = SPARSE (FAB = .FAB); 
IF (.OPEN_STATUS) 


BEGIN 


IF (((.FAB CEABSL_DEV] AND DEVS$M_TRM) NEQ 0) =! 
AND (.OPEN_ARG_BLK COPNSB_ORG] EQL OPNSK_ORG_TERMI) ! 
AND (.OPEN-ARG-BLK COPNSB-RFM] EQL OPNSK-RFM-DEFAU) | 
AND (.OPENARG-BLK COPNSB-RAT) EQL OPNS$K~RAT-DEFAU)) 


N 
ee BEGIN 
Turn off CR and turn on PRN. 
; FAB FABsV cR] = 0; 
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ss FAB CFABSV_PRNJ = 1; 
Change from VAR to VFC, so we can support PRN. 
FAB CFABSB_RFM) = FABSC_VFC; 
3 m FAB CFABS$B_FSZ) = 2; 
3 ; Any VFC field provided by the user is ignored. 
3 - CCB CRABSL_RHB] = CCB CLUB$W_BAS_VFC); 
ys ; make the terminal forcible. 
56 : CCB CLUBSV_FORCIBLE) = 1; 
5 56 END; 
5 57 
5 57 END; 
5 57 
3 27 IF (.CCB CLUBSV_OLD_FILE)) 
2 27 OPEN_STATUS = SOPEN (FAB = .FAB) 
5 57 OPEN_STATUS = SCREATE (FAB = .FAB); 
66 28 IF (.OPEN_STATUS) THEN CONNECT_STATUS = SCONNECT (RAB = .CCB); 
66 58 END; 
66 58 
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1b-se -1984 00:52:31 AX-11 Bliss-32 V4.0-742 Pa 4 
14-Sep-19 4 99:28:31 BASRTL. Re IBASOPEN.B32;91 we (33 
'¢ 

! If FABSV_CIF is set, set the ‘old file’ bit 


i 
: whether or not an existing file was found. | 
; set ‘old file’, for error checking. 


n the LUB based on 
f this is a CONNECT, always 


IF _ (CCB CLUBSV_M_STREAM] OR (.FAB CFABSV_CIF] AND (.FAB CFABSL_STS] NEQU RMS$_CREATED))) 
CCB CLUBSV_OLD_FILE) = 1; 


t+ 
! Store away the Directory ID in case CLOSE needs to delete the file. 
Also save the IFl. 


CHSMOVE (NAMSS_DID, NAM BLOCK CNAM$W_DIDJ, CCB CLUB$W_DIDJ); 
CCB CLUBSW_IFIJ = .FAB CFABSW_IFIJ; 


i If we have an expanded name string or a resultant name string, point 
! the LUB to it instead of the user-supplied name, to improve error 
: messages. 


IF (.NAM_BLOCK CNAMS$B_RSL] NEQA 0) 
THEN 


BEGIN 
CCB CLUBSA_RSN) = .NAM_BLOCK CNAMSL_RSA); 
CCB LUBSB-RSLJ = :NAM“BLOCK CNAMSB-RSLI: 


ELSE 
IF (.NAM_BLOCK CNAMSB_ESL] NEQA 0) 
THEN 


BEGIN 
ais CLUBSA_RSN] = .NAM_BLOCK CNAMSL_ESA); 
cc CLUBSB~RSL) = .NAM“BLOCK CNAMSB~ESL): 


'¢ 

! From here to the end of this routine, a call to BASS$S$STOP_IO prints the 
! expanded or resultant name from RMS, hence any error detection should be 
' done after this point, if this is reasonable. 


is 

: If OPEN or CREATE got an error, give an appropriate error message. 

IF ( NOT .OPEN_STATUS) THEN BASSS$STOP_IO (BASS$K_IOERR_OPE); 

'¢ 

! Since the CCB has been RMS OPENed, CLOSE it if we detect an error hereafter. 
Note that this will actually do a DISCONNECT if LUBSV_M_STREAM is set. 
UNWIND_ACTION = UNWIND_CLOSE; 


IF ( NOT .CONNECT STATUS) THEN BASSS$STOP_IO (BASS$K_IOERR_CON); 


aa 
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s 17, ¢ 641 ! If the device opened is a terminal, set the TERM_DEV bit in the LUB 
3 37 ets » | and allocate a prompt buffer. Also, set the margin to infinite. 
3 \y ¢ ah } Note that CONNECT is not permitted on terminals (because indexed only). 
: 1726 645 2 
; 4 f $68 Fs NOT .CCB CLUBSV_M_STREAM)) 
: 7 3 648 BEGIN 
: 7 1 850 4 TF (CFB CFABSL_DEV] AND DEVSM_TRM) NEQ 0) 
: 7 g 65¢ 4 BEGIN 
; 1735 654 4 LOCAL 
3 1736 3656 2 GET_VM_RESULT; 
: 1738 637 4 CCB CLUBSV_TERM_DEV) = 1; 
; 179 $699 ; IF ( NOT (GET_VM_RESULT = LIBSGET_VM (%REF (LUBSK_PBUF_SIZ), CCB CRABSL_PBFJ))) 
; 1768 266] 4 BASSS$STOP_IO (BASS$K_MAXMEMEXC); 
: 1744 2663 4 CCB CRAB$B_PSZ) = 0; 
; ins? $068 : CCB CRABSV_PMTJ = 1; 
> 1747 2666 5 IF (.OPEN_ARG_BLK COPNSW RECORDS 17] EQL 0) 
; 1768 s067 ‘ THEN CCB CLUBSW_D_MARGIN] = .FAB CFAB$W_BLSJ; 
: 1750 2669 4 CCB CLUBSW_R_MARGIN] = 0; 
3 17e1 $670 4 ey LUBSV-NOMARGIN] = 1; 
: 1783 267 : . 
: 1754 2673 3 t+ ; 
: 1755 2674 3! if the device opened is a Line printer, set the margin to the printer's 
A 1736 $07? width (if the user didn't specify RECORDSIZE). 
; 1758 2677 3 | the way we check to see if its a Line printer is to see if it IS a 
3 1759 2678 ! carriage-control device, IS an output device, IS record-oriented, 
; 1769 sore ; IS NOT an input device, IS NOT a mailbox, and IS NOT a terminal. 
: 1762 2681 4 IF ¢ ( (.FAB CFABSL_DEV] AND DEVSM_CCL) NEQ 0 ) AND 
: 176 2682 4 ( (.FAB CFABSL-DEV)] AND DEVSM_ODV) NEQ 0 ) AND 
3 1764 2683 4 ( (.FAB CFABSL-DEV)] AND DEVSM_-REC) NEQ 0 ) AND 
: 1765 684 4 ( (.FAB CFABSL-DEV] AND DEVS$M_IDV) EQL p ) AND 
: 1766 685 4 ( (.FAB CFABSL-DEV)] AND DEVSM“MBX) EQL 0 ) AND 
3 iver O38 $ aaa ( (.FAB CFABSL-DEV] AND DEVSM_TRM) EQL 0 ) ) 
; 1769 688 4 BEGIN 
; 1770 689 4 
: 1771 690 5 IF (.OPEN_ARG_ BLK COPNSW_RECORDSIZ) EQL 0) 
; 77e 691 ‘ THEN CCB CLUBSW_D_MARGIN] = .FAB CFABSW_BLS); 
: 1774 $038 4 CCB CLUBS$W_R_MARGIN] = 0; 
: 1779 69% 4 CCB LUBSV-NOMARGIN) = 1; 
: 1777 696 ; : 
: 1778 697 END; 
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3; 178 700 '¢ 

; 178 701 i Version 7 stores the MAP buffer size and the recordsize in the OPEN block. 

3; 1784 re i if th S a version 2 program, make the check here for a recordsize longer 

3; 1785 70 i than che user's buffer. 

3 1798 704 ie 

3; 178 705 

>; 1788 re IF (.OPEN_ARG_BLK COPNSB_CNT] GTR K_V1_BLK_SIZE) AND 

; 1782 at4 (-OPEN ARG_BLK COPNSA-MAP) NEQA 0) 

3 173) a4 : if (,OPEN_ARG_BLK COPNSW_MAP_SIZE] LSSU .OPEN_ARG_BLK COPNS$W_RECORDSIZ]) 

3 1798 aa BASSS$STOP_10 (BASSK_RECOVEMAP) ; 

3; 1794 at 

3: 1795 271 ‘+ 

3 1796 2714 i If the file just opened was already in existence, perform 

3 1797 2715 i consistency checks between the file's attributes and the 

3 1798 2716 i open parameters. 

; 17 2717 i. 

; 1800 2718 

: 1801 sip IF (.CCB CLUBSV_OLD_FILEJ) 

; 1808 720 THEN 

; 180 2721 BEGIN 

3; 1804 sis¢ '¢ F 

; 1805 272 i Organization check: If the user did not spec ity an ergentzetten 

: 1806 2724 i with this OPEN, use the attributes from the file. Otherwise, 

3 1807 2725 i check that the user's specification egrees with the file. | 

; 1808 2726 i Store the organization in the LUB if the user did not specify one. 

Me Begs 

3 1811 2729 3 CASE (.OPEN_ARG_BLK CGPNSB_ORG]) FROM OPNSK_ORG_TERMI TO OPNSK_ORG_UNDEF OF 

: 1812 2730 SET 

3; 1813 2731 

> 1814 $ie6 COPNSK_ORG_TERMI] : 

3; 1815 e735 4 

; 13i¢ shee : CCB CLUB$B_ORGAN] = LUBSK_ORG_TERMI; 

; Hh 444 $335 2 IF (.FAB CFABSB_ORG] NEQ FABSC_SEQ) THEN BASSS$STOP_IO (BASSK_FILATTNOT); 
3 1330 2738 END; 

: 1821 2739 

: i8ee site COPNSK_ORG_VIRTU] : 

3; 182 741 4 IN 

° ieee ots ? CCB CLUBSB_ORGAN] = LUBSK_ORG_VIRTU; 

3 1836 3764 2 IF (.FAB CFABS$B_ORG] NEQ FABSC_SEQ) THEN BASS$$STOP_IO (BASS$K_FILATTNOT); 
: 1828 746 END; 

3 HTH 747 

3; 1830 748 COPNSK_ORG_SEQUE] : 

: 1831 749 4 N 

3 1836 220 2 CCB CLUBSB_ORGAN) = LUBSK_ORG_SEQUE; 

; Ht 236 ; IF (.FAB CFABS$B_ORG] NEQ FABSC_SEQ) THEN BASS$STOP_IO (BASSK_FILATTNOT); 
3 1836 754 END; 

3; 1837 755 

; 1838 756 COPNSK_ORG_RELAT] : 
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; 1839 ey 4 BEGIN 

; | 40 £28 4 CCB CLUBS$B_ORGAN] = LUSSK_ORG_RELAT; 

: Hak rey 2 IF (.FAB CFABSB_ORG] NEQ FABSC_REL) THEN BASS$S$STOP_IO (BASS$K_FILATTNOT); 
> 1844 76 END; 

>; 1845 58 ; 

3: 1846 764 COPNSK_ORG_INDEX] : 

3; 1847 765 4 

3 H ek: ihe ? CCB CLUBSB_ORGAN] = LUBSK_ORG_INDEX; 

: 1330 108 2 IF (.FAB CFABSB_ORG] NEQ FABSC_IDX) THEN BASS$$STOP_IU (BASS$K_FILATTNOT); 
3 182¢ 770 END; 

; 185 771 

3: 1854 oe COPNSK_ORG_UNDEF] : 

>; 1855 77 '¢ 

; 1856 774 : If the user does not specify the organization, accept whatever 
; 1857 2775 ! is in the file. 

>; 1858 2776 te 

3; 1859 e777 & BEGIN 

; 1860 2778 4 

: 1861 e779 4 SELECTONE (.FAB CFABSB_ORG]) OF 

; 1868 2780 4 SET 

3; 186 2781 4 

3 1864 HAT 4 CFABSC_SEQ) : 

: 1865 2783 4 CCB CLUB$B_ORGAN] = LUBSK_ORG_SEQUE; 

>; 1866 2784 4 

3; 1867 2785 4 CFABSC git : 

3; 1868 2786 4 ccB LUBSB_ORGAN] = LUBSK_ORG_RELAT; 

3 1869 2787 4 

; 1870 2788 4 CFABSC_IDX] : 

3; 1871 2789 4 CCB CLUB$B_ORGAN) = LUBSK_ORG_INDEX; 

; 1876 2790 4 

3; 187 2791 & COTHERWISE) : 

3; 1874 1454 4 BASSS$STOP_IO (BASSK_FILATTNOT); 

>: 1875 144 4 TES; 

3: 1876 794 4 

3: 1877 2795 3 END; 

: 1878 2796 3 TES; 

3; 1879 2797 ; 

3; 1880 e798 Ste } 

; 1881 2799 : Verify that the user-declared bucket size agrees with the file. 
3 1386 $B00 ! If the user specified zero, we accept the file attribute. 

3; 188 801 != 

> 1884 o0¢ 

3; 1885 803 5 IF ((,OPEN_ARG BLK COPNSW_BUCKETSIZ) NEQ 0) ’ 

3; 1886 804 6 AND (({OPER_ARG_BLK COPNS$B_ORG) EQL OPNSK_ORG_RELAT) , 
3; 1887 805 4 OR (.OPEN_ARG_BCK COPNSB_ORG] EQL OPNSK_ORG_INDEX))) 
: 1889 30? ~ 

; HS a ri IF (.BKS NEQ .FAB CFABSB_BKS]) THEN BASS$STOP_I0 (BASSK_FILATTNOT); 
3 1892 810 '¢ : : 

3; 189 811 ! Verify that the user-declared block size agrees with the file. 
; 1398 Bis ! If the user specified zero, we accept the file attribute. 
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ce COPN$W_BLOCKSIZE] NEQ 0) AND (.FAB CFABSB_ORG] EQL FABSC_SEQ)) 


IF (.BLS NEQ .FAB CFABS$W_BLS]) THEN BASSSSTOP_IO (BASSK_FILATTNOT); 


'¢ 
: Verify that the user-declared record size agrees with the file. 
: If the user specified zero, we accept the file attribute. 


: CCB CLUBSW_RBUF_SIZE) = MAXU ( .FAB CFABSW_MRSJ 
-XABFHC CXABSW_LALJ ); 


14 
If the file's purported record size is zero, use a reasonable size. 


IF (.CCB CLUBSW_RBUF_SIZE] EQL 0) THEN CCB CLUBSW_RBUF_SIZEJ = .RSZ; 


'¢ 
: if the record buffer is still zero-length at this point, try looking 
at FABSW_BLS. 


IF (.CCB CLUBSW_RBUF_SIZE] EQL 0) THEN CCB CLUBS$W_RBUF_SIZE] = .FAB CFABSW_BLSJ; 


be 
: If the user specifies a record size, make sure that the file has that record size 
: (for files with fixed-length records). For files with variable-length 

! records, the check is on y necessary if the MRS is set and the file is opened 

: for write access. No checking is done here for variable length record files 

» Since RMS will catch the error at write time. 


IF (OPEN ARG_BLK COPNSW_RECORDSIZ] NEQ 0) 
IF (FAB CFABSB_RFM] EQL FABSC_FIX) 
IF (.RSZ NEQ .CCB CLUBSW_RBUF_SIZEJ) THEN BASSSSTOP_IO (BASSK_BADRECVAL); 


'¢ 

: for V2 programs, check the MAP size too, since if no RECORDSIZE is specified 
i but a MAP Size is, OPEN ARG_BLKCOPNSW RECORDSIZ) will still be zero. This 

! is different from V1, where the compiler would give us the MAP value in the 
} RECORDSIZE field. 


IF ((.OPEN_ARG_BLK COPNSB_CNT] GTR K_V1_BLK_SIZE) AND 
ia (.OPEN-ARG_BLK COPNSA_MAP) NEQA™0)) 


N 
IF (.RSZ2 LSS .CCB CLUBSW_RBUF_SIZE]) THEN BASS$STOP_IO (BAS$K_BADRECVAL); 


The buffer size we actually use must be at least as large as the user 
declared. 


If the user did not declare a buffer size, then we want to ; 

use the maximum record size from the file. If no MRS is set for the file and 
the user did not declare a buffer size, then we will use the max of the 
default recordsize and the longest record length. This guards against 
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'3 1959 87 
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; 1206 880 
3; 196 881 
>: 1964 gee 
> 1965 8 
3; 1966 2884 
3; 1967 2885 
; 1968 886 
3; 1969 887 
; 1970 888 
; 1971 2889 
; 136 Sear 
; 197 891 
> 1974 $896 
; 1975 289 
3; 1976 2894 
: 1977 2895 
; 1978 2896 
3; 1979 2897 
; 1980 2898 
; 1981 2899 
3 1986 2900 
; 198 901 
3; 1984 90 
3; 1985 290 
; 1986 2904 
; 1987 2905 
; 1988 § 
; 1989 90 
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: petty a file with only short records in it (and MRS=0) and being unable 
‘. to write a large record. 1-i'3 


fe ee AND (.FAB CFABSW_MRSJ NEQ 0)) 


ELSE 
CCB CLUBSW_RBUF_SIZE] = MAXU (.CCB CLUBSW_RBUF_SIZE], .RSZ); 


'¢ 
i If the user is using a MAP, the record size must not be longer than the 
i. space in the map. 


4 IF > he “Oren ARG_BLK COPNSA_MAP] NEQA 0) AND 
4 B CLUBSW_RBUF_SIZE] LSSU .OPEN_ARG_BLK COPNSW_ RECORDS1Z))) 
senenten 3 (BAS$K_BADRECVAL); 
'¢ 
g If the organization is virtual, the buffer size must be at least 512 bytes. 
4 IF i. “orem ARG_BLK COPNSB_ORG) roy im -ORG_VIRTU) AND ' 
4 nen" B TLUBSW_RBUF _SIZE] LSSU 512 
BASS$STOP_JO (BASSK_BADRECVAL); 
'¢ 
i Verify that the user-declared record format agrees with the file. 
1 
5 
4 
3 
4 
4 
4 
4 


' If the user did not specify a record format, we accept the file 
& attribute. 


CASE (OPEN. ARG_BLK COPNSB_RFM]) FROM OPNSK_RFM_DEFAU TO OPNSK_RFM_STREA Of 


COPNSK_RFM_DEFAU) : 
i "Don t check for virtual and undefined. 


IF (C. OPNSK. ORG ONDEF)) COPNSB_ORG] NEQ OPNSK_ORG_VIRTU) AND (.OPEN_ARG_BLK COPNS$B_ORG) NEQ 


te 
: If the device is a terminal, it is opened in PRN format. 


IF (((, FAB CFABSL_DEV] AND DEVSM_TRM) NEQ Q) : 
AND ( -OPEN_ARG_BLK COPNSB_ORG] EQL OPNSK_ORG_TERMI) 
aor ; -OPEN_ARG_BLK LOPNSB_RFM) EQL OPNSK~ ~RFM_DEF AU) : 
(.OPEN-ARG_BLK COPNSB_RAT) EQL OPNSK_RAT_DEFAU)) 
“BEGIN 


IF (FAB CFABSB_RFM) NEQ FABSC_VFC) THEN BASS$STOP_IO (BASSK_FILATTNOT); 
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IF (.FAB CFABSB_FS2] NEQ 2) THEN BASSS$STOP_IO (BASSK_FILATTNOT); 
END; 
COPNSK_RFM_FIXED) : 
IF (.FAB CFABSB_RFM] NEQ FABSC_FIX) THEN BASSS$STOP_IO (BASSK_FILATTNOT); 
COPNSK_RFM_VARIA] : 
IF a FAB CFABSB_RFM] NEQ FABSC_VAR) AND (.FAB CFABSB_RFM] NEQ FABSC_VFC)) 
NBASSSSTOP.. 10 (BASSK_FILATTNOT); 
COPNSK_RFM_VFC) : 
BEGIN ~ 


IF (.FAB CFABSB_RFM] NEQ FABSC_VFC) THEN BASS$$STOP_IO (BASSK_FILATTNOT); 
IF (.FAB CFABSB_FSZ] NEQ .OPEN_ARG_BLK COPNSB_FSZJ) THEN BASS$S$STOP_IO (BASSK_FILATTNOT); 
END; 


COPNSK_RFM_STREA, OUTRANGE) : 
$: BASSSSTOP_IO (BAS$K _FILATTNOT); 


1e 
Verify that the user-declared record attributes agree with the file. 


CASE (OPEN ARG_BLK COPNSB_RAT]) FROM OPNSK_RAT_DEFAU TO OPNSK_RAT_ANY OF 


COPNSK_RAT_DEFAU) : 
s¢@ 
: If the device is a terminal, it is opened in PRN format. 
IF ec. FAB CFABSL_DEV) AND DEVSM_TRM) NEQ 0) ! 
AND (.OPEN_ARG_BLK COPNSB_ORG] EQL OPNSK_ORG_TERMI) 
ue -OPEN_ARG_BLK COPNSB_RFM) EQL OPNSK_RFM_DEF AU) 
THEN D (.OPEN_ “ARG” BLK OPNSB_ RATJ EQL OPNSK_ RAT ~DEF AU) 
BEGIN 
IF ( NOT .FAB CFABSV_PRN]) THEN BASS$$STOP_1O0 (BASS$K_RECATTNOT) 


END 
ELSE 
'¢ 


: If the organization is virtual, it should have RAT NONE or CR. 


) 


1F (OPEN, ARG_BLE COPNSB_ORG] EQL OPNSK_ORG_VIRTU) 
BEGIN 
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ASSOPEN 
as 
067 985 
068 359 
069 98 
070 988 
071 989 
Ore 990 
07 991 
2074 $398 
2075 99 
s076 2994 
077 2995 
sore 996 
079 997 
2080 998 
2081 999 
s08e 000 
208 001 
2084 00 
2085 300 
2086 3004 
2087 3005 
2088 3006 
i624 3007 
090 008 
2091 3009 
209 $010 
209 3011 
2094 alg 
2095 301 
2096 3014 
2097 3015 
2098 3016 
2099 3017 
2100 3018 
2101 3019 
2102 3020 
2103 3021 
2104 z0S6 
2105 302 
2106 3024 
at'44 3025 
108 3026 
2109 3027 
$119 Hi 8 
111 029 
2112 3030 
2113 3031 
114 O38 
115 03 
116 bee 
117 035 
118 b39 
OR 
154 $38 
\$¢ 040 
212 3041 
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IF (.FAB CFABSV_FTN] OR .FAB CFABSV_PRN]) THEN BASS$$STOP_IO (BAS$K_RECATTNOT) 


END 
ELSE 


IF ( NOT .FAB CFABSV_CR]) THEN BASS$SSTOP_IO (BASS$K_RECATTNOT); 
COPNSK_RAT_FORTR] : 
IF ( NOT .FAB CFABSV_FTNJ) THEN BASSSSTOP_IO (BASSK_RECATTNOT); 
COPNSK_RAT_CRLF) : 
IF ( NOT .FAB CFABSV_CR]) THEN BAS$SS$STOP_IO (BAS$K_RECATINOT); 
COPNSK_RAT_NONE] : 
| 
| 
| 


If (FAB CFABSV_CR] OR .FAB CFABSV_FTN] OR .FAB CFABSV_PRNJ) 
BAS$$STOP_IO (BAS$K_RECATTNOT); 
COPNSK_RAT_PRINT) : 
IF ( NOT .FAB CFABSV_PRNJ) THEN BASSS$STOP_IO (BAS$K_RECATTNOT); 
COPNSK_RAT_ANY] : 
BEGIN ~ 


0 
END; 


COUTRANGE] : 
Tes BAS$$STOP_I10 (BASS$K_RECATTNOT); 


'¢ 
Mark the file as being in PRN format, if it is. 


IF (.FAB CFABSV_PRNJ) THEN CCB CLUBSV_PRN) = 1; 


'¢ 
: Check keys for indexed file organization. 


IF ((,OPEN_ARG_BLK COPNS$B_ORG) EQL OPNSK_ORG_INDEX) AND (ACTUALCOUNT () GEQ 2)) 
BEGIN 


LOCAL 
XABKEY : REF $XABKEY DECL, 
Kev pie : REF BLOCK [O, BYTE] FIELD (OPNSKEY_BLOCK), 
'¢ 
! The number of nove specified in the argument List must be less than or 
! equal to the number of keys in the file, as recorded in the summary XAB. 
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! If the number of were in the argument List is more than the number of 
keys in the file, then give the user an error. 


LF (.KEY_INFO_BLK CKEYHS$B_KEYNUM] GTRU .XABSUM CXAB$B_NOK]) 
BASSSSTOP_IO (BAS$K_FILATTNOT); 


'¢ 

! Each key must match the argument List. The keys are stored in the XABKEY 
: blocks that were set up before the OPEN. Search through the XABKEY blocks 
matching each with the argument List. 

XABKEY = .FAB CFABSL_XAB]; 


WHILE (.XABKEY NEQA 0) DO 
BEGIN 
IF (.XABKEY CXABS$B_COD] EQL XABSC_KEY) 
THEN 


BEGIN 
KEYNO = .XABKEY CXABSB_REFJ; 


] 
KEY_PTR = (.KEY_INFO_BCK CKEYHSB_LENJ®*.KEYNO) + KEYHSK_LENGTH + .KEY_INFO_BLK; 


+ 
! Check the size, position, CHANGES and DUPLICATES of 
each key. 


if ((.XABKEY CXABS$W_POSO] NEQ .KEY_PTR CKEYSW_OFFS 
OR N PTR CK 


'¢ 

! Check the data type of each key. : 

! Basic has no unsigned data type, so we must allow signed 

' word & longword keys to open a file with unsigned word and 
lLongword keys. 


CASE -KEY_PTR CKEYSB_DTYPE] FRCM DSCSK_DTYPE_W TO DSCSK_DTYPE_P OF 


+ 
user program has signed word key 


B.p1Fi NEQ XABSC_IN2 ! signed word 
AND .XABKEY CXABSB_DTP] NEQ XABSC_BN unsigned word 
THEN BAS$S$STOP_IO” (BASSK_FILATTNOT); 


'¢ 
user program has signed longword key 
COSC$K_DTYPE_L 


}: 
1F~. XABKEY Xapse DIP} NEQ XABSC_IN4 ! signed longword 
AND .XABKEY CXABSB_DTP] NEQ XABSC_BN4 ! unsigned longword 


—@w 
‘> 
un 
Wo 
v 
m 
2 


DIDI II a at at at ot tt 2 YS SO 
SCOOS000000000 000000900 09 000 0000 
WN “SO OONAUNEWN —“OOONOUE WN 


FAR 


POPOPOPONIMOPUNOMONoNoNononofmonoenoeny» m 


os 
DODOOOODODOODOOOODWO OOOO ODD IPP A PAPA AAPA AAPA AAA AA AA AAA AAA AAAA OS 


AOE WN OO OODNOU SEWN —OOON 


POPIPOPININIPUPINIPININIPO PIPPIN NPN PoNoPononononofnonononononononononofornononofnerponefenn 


WAT OPSPUPIPINIPONONUDD 2 2 OO OS OOOO 
~ 


wn —O0Oon 


SARS 


AAWAAIN NIAAA ANAM AANA AAAI NAA AIAN AIWN NA WIN AA ANIA NIAAA AANA 


a a ae ae a a a a a a ae a a el ee a ee a a a a a a a a a a a a a a a a a ed a a ed a OD 
Pn B BB BEL EEE BANNAN WIP NINIPININPD 2 2 OO OS S| SS DOOOOOOOCOOC NO 
PEW 0 OONO UE 0 OD NOA NE WIN $ O ODNAU EWN HO ODNOAUES WN ("ODO ONAUES WN "O”0 


PohPononofonononononofonypnononofry 


Nm 
w 
™~ 


4 
18-Sep-1984 00:52:31 YAX=11 BLiss-32_v4.0-742 Page 44 
1e=8ep=1984 91:55:24 ERASRTLSRESBASOPEN BS2—91 $9 (10) 


THEN BASS$STOP_IO (BASSK_FILATTNOT); 


4 
user program has text key 


CDSCS$K_DTYPE_T) : 
IF~.XABKEY CXABSB_DTP] NEQ XABSC_STG ! string 
THEN BASS$SSTOP_I0” (BASSK_FILATTNOT); 


'¢ 

user program has packed decimal key 

CDSCSK_DTYPE_ PI : ; 
IF~.XABKEY CXABSB_DTP] NEQ XABSC_PAC ! packed decimal 
THEN BASS$S$STOP_IO (BASSK_FILATTNOT); 

'¢ 

user program has some other data type key 

CINRANGE, OUTRANGE] : 
IF .XAB 


-XABKEY CXABS$B_DTP] NEQ XABSC_STG ! string 
THEN BAS$$STOP_I0° (BASSK_FILATTNOT); 


TES; 


+ 
! For V2 programs, check all the key segments if there are 
multiples. 


IF; OPEN.ARG_BLK COPNS$B_CNTJ GTR K_V1_BLK_SIZE 


BEGIN 
IF .KEY_PTR CKEYSB_NUM_SEG] GTR 0 
THEN 


NUM FROM 1 TO .KEY_PTR CKEYSB_NUM_SEG] DO 


KEY_NUM FROM 1 TO 7 OF 

3: 

(.MABKEY CXAB$W_POS1] NEQ .KEY_PTR CKEYSW_OFFSET1}) OR 
(IXABKEY EXABSB7S1Z1] NEQ :KEYZPTR CKEYSB7LENT)) 


BASS$STOP_IO (BASSK_FILATTNOT); 


E 
1 
IF 


(2): 
IF (.XABKEY CXABSW_POS2] NEQ .KEY_PIR [KEVSu_OFFSET2]) OR 
([XABKEY CXAB$B7S122) NEQ :KEYTPTR CKEYSB~LEN2)) 


BASSSSTOP_IO (BASSK_FILATTNOT); 

(3): 

IF (.XABKEY CxaBsu POSS] NEQ .KEY_PTR CKEYSW_OFF E13) OR 
({XABKEY CXAB$B7S123) NEQ .KEYTPTR CKEYSB~LEN3J) 
BAS$SS$STOP_I10 (BASSK_FILATTNOT); 
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(4): 

IF (.XABKEY pease Ose NEQ .KEY_PTR pee yay Ere T4]) OR 
(.XABKEY CXAB$B_S1Z4] NEQ .KEY_PTR CKEYSP_LEN4)) 

BASSSSTOP_IO (BASSK_FILATTNOT); 

(5): 

IF (.XABKEY CXABSW_POSS] NEQ .KEY_PTR Aa OR 
(.XABKEY CXAB$B-S1Z25] NEQ .KEY-PTR CKEY$B_LENS)) 

BASS$STOP_IO (BASSK_FILATTNOT); 

(6): 

IF (.XABKEY Pretest NEQ .KEY_PTR CKEYSW_OFFSET6]) OR 
- aatarneaie XAB$B_S1Z26] NEQ .KEY_PTR CKEYS$B_LEN6)) 

BASS$STOP_I10 (BASSK_FILATTNOT); 

(7): 

IF (.xXABKEY berate NEQ .KEY_PTR CKEYSW_OFFSET7J) OR 
(.XABKEY CXAB$B_S$1Z7] NEQ .KEY_PTR CKEY$B_LEN7J) 
BASS$STOP_IO (BASSK_FILATTNOT); 

TES; 
END; ! end of yee each segment 
END; ! end of if segmented key 
END; ! end of if V2 program 
END; ! end of if key XAB 


XABKEY = .XABKEY CXABSL_NXT]); 
END; ! end of processing this XAB 


END; ! end of old indexed file processing 
END ! end of old file processing 
ELSE 
a BEGIN 
i This is anew file. If it is organized relative or index, the user 
} must have specified a record size. 
IF (.RSZ EQL 0) THEN BASS$STOP_IO (BASSK_BADRECVAL) ELSE CCB CLUBSW_RBUF _SIZE] = .RSZ; 


'¢ 


Make sure the LUB ‘append’ flag is off so FORTRAN BACKSPACE will work. 
. CCB CLUBSV_APPEND] = 0; 

i Set LUBSB_ORGAN based on the OPEN argument. This is legitimate since 
we just created the file, so it must agree with the OPEN argument. 


CASE. OPEN, ARG_BLK COPNSB_ORG) FROM OPNSK_ORG_TERMI TO OPNSK_ORG_UNDEF OF 


_—- —-_----- . - _ SS 
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95 
9 COPNSK_ORG TERMI) : 
f CCB CLOBSB_ORGAN] = LUBSK_ORG_TERMI; 
99 COPNSK_ORG VIRTUJ : 
O9 CCB CLOBSB_ORGAN] = LUBSK_ORG_VIRTU; 
o¢ COPNSK_ORG SEQUE) : 
6? CCB CLOBSB_ORGAN] = LUBSK_ORG_SEQUE; 
05 COPNSK_ORG_RELAT) : 
CCB CLOBSB_ORGAN] = LUBSK_ORG_RELAT; 
08 COPNSK_ORG_ INDEX] : 
CCB CLOBSB_ORGAN] = LUBSK_ORG_INDEX; 
COPNSK_ORG_UNDEF] : 
- BASS$$STOP_IO (BASS$K_FILATTNOT); 


'¢ 
Don't allow an open with ACCESS READ to create a file. 


IF (.OPEN_ARG_BLK COPNSB_ACCESS] EQL OPNSK_ACC_READ) THEN BASS$STOP_IO (BAS$K_ILLILLACC); 


4 
A virtual file's record size must not be less than 512 bytes. 


IF ((.OPEN_ARG_ BLK COPNSB_ORG] EQL OPNSK_ORG_VIRTU) AND ' 
s yore Css $12)) 
BASSSSTOP_I1O0 (BAS$K_BADRECVAL); 


END; ! End of new file processing 


BREE EEE EE FAW ANNAN AIAIDIPPPINININININID 2 2 OOO 


'¢ 
! Validate the record format. It must be one of those the run-time 
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1S 
res PASSSSTOP_10 (BASSK.FILATINOT) ; 
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5 
5 
334 25 ! Library can process. In particular, we don't permit UNDEFINED unless 
335 25 ! the organization is UNDEFINED. 
337 335 
338 $3 IF (.OPEN_ARG_BLK COPNSB_ORG] NEQ OPNSK_ORG_UNDEF ) 
ace Be tee 
341 25 SELECTONE (.FAB CFABSB_RFMJ) OF 
306 $6 SET 
53 6 CFABSC_FIX, FABSC_VAR, FABSC_VFC) : ! This is ok. 
“ e 
347 COTHERWISE) : 
348 
349 
9 
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AS -MABKEY CXABS$B_COD] EQL XABSC_KEY) 
BEGIN 


i we have found a key XAB. Unlink it from the XAB chain and free it. 
' We have remembered XAB_PTR as its chain location. 


= ,XABKEY CXABSL_NXT] 
FREE “in. STATUS = LIBSFREE- va (EREF (XABSC_KEYLEN), XABKEY); 


IF ( NOT .FREE_VM_STATUS) THEN BASSSSTOP_IO (BASS$K_PROLOSSOR) ; 


: 28 70 ! Record the record attribute, record format block size and bucket 
: a 4 i size in the LUB, for the FSP$ function and for connect. 

: 55 ig CCB (LUBSB_RAT) = .FAB CFABSB_RAT ; 

; 2356 74 CCB CLUBSB"RFM] = .FAB [FABSB_RFM]; 

3 57 75 CCB (LUBSB_BKS) = .FAB [FABSB_ _BKS : 

; 2358 7 CCB CLUBSW_BLS)] = .FAB CFABSW_BLSJ; 

; 2359 7 CCB CLUBSL_ALQ) = .FAB CFABS$L_ALQ); 

> 2360 7 CCB tUBSst “REC “MAX] = 

3 30) ie BEGIN 

; 308 28 ee ARG_BLK COPNSB_ORG] FROM OPNSK_ORG_TERMI TO OPNSK_ORG_UNDEF OF 
: $302 8s COPNSK_ORG. VIRTU) : 

; et 3 -FAB CFABSL -ALQ); 

; $399 87 carats x ORG UNDEF] : 

: 2370 288 FABSL_MRN); 

3 § 71 3289 

; Le: 3290 CINRANGE] : 

3 2374 $36 TES 

3; 2375 29 

3; 2376 294 

3 $3if 295 

; 2378 296 i "Remember the device characteristics, in case the user calls 
3 $328 3297 

: 2380 $596 

3; 2381 299 L_STATUS = .FAB CFABSL_DEV]; 

: See 3300 

; 238 3301 i “Free the key XABs, since they were allocated from virtual storage. 
3: 2384 $208 s 

; S362 330 BEGIN 

3; 2386 Sane ; 

3; 2387 305 LOCAL 

3; 2388 306 XABKEY : ort SXABKEY_DECL, 

3 2389 307 FREE_VM_STATUS, 

: 2390 308 XAB_PTR> 

: 2391 3309 

; $08 3310 XAB_PTR = FAB CFABSL_XAB); 

3 2394 ; WHILE (..XAB_PTR NEQA 0) DO 

: ; 4 BEGI 

; 4 ? MABKEY = ..XAB_PTR; 

3 5 

} 


SERVI 
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END 
ELSE 

XAB_PTR = XABKEY CXABSL_NXT]; 
END; 

END; 
'¢ 


; Allocate and clear a record buffer unless the user provided one. 


IF (.OPEN_ARG_BLK COPNSA_MAP] EQLA 0) 
BEGIN 
LOC 


MOMINOTORONUNIPONnoTPnorfnonnnnry 


at et ee et et ek al et keke eee ee le ed 


, a bt pee Og ee eee at te et a Ss aD 


oonmn 


AL 
GET_VM_RESULT; 


‘+ 
If recordsize is still 0 then signal an error. 


MEWN $9 OONOAUE WN HK OODONOUNE WO 0 


2 

2 

2 IF (.CCB CLUBSW_RBUF_SIZE) EQL 0) THEN BASS$STOP_IO (BAS$K_BADRECVAL); 

3 GET_VM_RESULT = LIBSGET_VM (ZREF (.CCB CLUBSW_RBUF_SIZEJ), CCB CLUBSA_RBUF_ADRJ); 
é IF ( NOT .GET_VM_RESULT) THEN BASSS$STOP_IO (BASSK_MAXMEMEXC) ; 


te 
! Make sure the buffer is null, in case the user fetches from it before 
the first GET. 


+ hae (0, .CCB CLUBSW_RBUF_SIZEJ, .CCB CLUBSA_RBUF _ADR)); 


BEGIN 
CCB CLUBSA_RBUF_ADR] = .OPEN_ARG_BLK COPNSA_MAP); 
cc LUBSV“USER-RBUF) = 1; 


WN AA AA AN AWN AIANI WWI ANAWIAI NWA NIA AINNWIAAAN AANA 
PARE Q_R_RQAEDQDMAA As BB BE EE EAN ANI Wrornorn 
MEW $9 OD NAMES WN $9 OONAUE WN S(O CONOUE WN" O0On 
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448 366 ; 

449 367 

450 368 ¢ 

451 369 ! Allocate dynamic storage for the file name so that the name can be 
359 ! used later for error diagnostics. Point the LUB to the new location. 
71 ! Indicate that the space pointed to must be deallocated when the file 

454 376 ! is closed. 

455 37 te 
3e BEGIN 

458 378 OCAL 

459 37 GET_VM_RESULT, 

460 378 OLD-ADBRESS; 

461 379 

46 $39 OLD_ADDRESS = .CCB CLUBSA_RSN); 

vet 81 GET VM_RESULT = LIBSGET_VM (ZREF (.CCB CLUBSB_RSLJ), CCB CLUBSA_RSN]); 

465 383 IF ( NOT .GET_VM_RESULT) THEN BASSSSTOP_I10 (BASSK_MAXMEMEXC) ; 
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3 24 4 
; 246 5 CHSMOVE (.CCB FLUGSG_ASL I. -OLD_ADDRESS, .CCB CLUBSA_RSNJ); 
> 2468 6 CCB CLUBSV_VIRT_RSNJ-= 1; 
3 re 9 #4 a END; 
; 471 89 Set those RAB fields that seldom change. 
: 247 91 2° CCB CRABSL_UBF) = .CCB CLUBSA_RBUF _ADR); 
> 2676 3% CCB CRABSW-USZJ = .CCB CLUBSWRBUF-SIZE); 
; 479 93 ,, 068 CLUBSAUBF] = .CCB CLUBSATRBUF -ADRI; 
; ry hd 44 Clear LUBSA_FAB to indicate that the FAB is no longer present. 
3 2479 97 2 ~3=ccB FLUBSA_FAB = 0; 
3 me 1 38 a CCB CRABSL_FAB) = 0; 
; rt ret} Indicate that the file is now open for BASIC. 
> 2486 408 "CCB CLUBSB_LANGUAGE] = LUBSK_LANG_BAS; 
: tH ret a CCB CLUBSV_OPENED) = 1; 
3 2487 3405 i Make sure that the BASIC exit handler will be called when the image 
: 2488 3406 ! exits to purge the file's 1/0 buffers and close it, if necessary. 
: 2489 3407 ! This can happen if the user's Last PRINT statement ends with a 
3: 2490 408 § ! comma or a semicolon. 
ee ie 
> 249 3411 5 IF ( NOT .BASSSL_XIT_LOCK) THEN BASSSDECL_EXITH (); 
: Seg 313. 3s 
+ 2496 3414 2 | Pop back previous LUB or indicate that no 1/0 statement 
3 et ez $ is currently active. 
88 0 BU 8 peste rer 02 
: 2501 3419 1 ND; ! end of BASSOPEN 
-TITLE BASSOPEN 
-IDENT \1-113\ 
-PSECT _BASSDATA,NOEXE, PIC,2 
00000000 00000 L_STATUS: 
-LONG 0 


.EXTRN BASSSL_XIT_LOCK 

“EXTRN LIBSSTOP, GASSS$STOP 

“EXTRN BASS$SSTOP_I0, BAS$S$CB_PUSH 
BASS$CB om 


PROC 
RN BASSKTILLI 
RN BASSKILLI 
RN BASS$K~10_C 
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~PSECT _BASSCODE,NOWRT, SHR, PIC,2 


OFFC 00000 ENTRY BASSOPEN, Save R2,R3,R4,R5,R6,R7,RB8,R9,R10,-; 1409 
SE FocO CE 9€E 0000 MOVAB -576(SP) : 

50 AE 7C 0000 CLROQ YNwIND CC ctor + 1446 
6D 10E4 CF DE OOO0A MOVAL : 

54 AE D4 O000F CLRL UNWIND AC TION + 1500 

50 04 aC ec ci 00012 ADDL Cros OPEN ARG _BLK, RO ; 1505 

50 06 ac 05 ci 00018 ADDL3 OPEN a “BLK, RO + 1507 
2c OA 60 9€ C1020 MOVAB "a6 44TSP)~ : 
11 2C sé 06 €1 60024 BBC #6, a44(SP), 28 : 

2c BE 93 0009 Ist a44(SP) ; 1510 

44 sO 44 BE $2 O00¢5 cVTWL aCHANNEL , CHANNEL ; 1512 

44 AE 44 BE DO 00035 1$: MOVL § @CHANNEL, CHANNEL : 1514 

52 44 AE D0 O003A 2$: MOVE CHANNEL, Re ; 1520, 

00000077 —s BF 32 b} 90049 CMPL R2, #119 
7E 006 8F 9A 00049 3$: MOVZBL HBASSK ILLIO_CHA, (SP) : 

prermngene Se g) AB Soose as: Fett nreomtaed 1526. 
0B 12 00056 BNEQ  5$ : 
7E 006 8F 9A 00058 MOVZBL W#BASS$K_ILLIO_CHA, -(SP) ; 

000000006 00 01 FB 0005¢ CALLS #1, BASS$STOP : | 

3c = AE. s«#4 00063 SS: CLRL_ NO MAP_REC SPECIFIED + 1531 

50 04 AC 0c 1 00066 ADDL3 #12, OPEN gARG.8 RO + 1532 
* § 14 RE BO OooeE Ne {R05 52 Ose) 

4 09 $095 BNEQ ; + 1534 

34 06 Bc 91 00075 CMPB  §@OPEN_ARG_BLK, #52 : 1542 
13 1B 00079 BLEQ ; 

50 04 Ac 34 C1 00078 ADDL3 #52, OPEN_ARG_BLK, RO > 1543 | 
60 8 0080 TSTw (ROS F 
A 0082 BEQL 6 3 

50 04 AC 4 ¢1 000 ADDL3 #52 OPEN_ARG_BLK, RO > 1545 
8 o $e o0gs ——ROVTUL (86S, , 

1 4 ai OMAP R P CIFIED > 1548 

» st Ae Rea eM ata ar 
05 00 60 8F 009 CASEB Cn) : 
000¢ 0010 0016 0010 098 7$: <WORD 9$-7 ig! - : 
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| BASSOPEN 16-Sep-1984 00:52:31 AX=-11 Bliss=-32 V4.0-742 Page 52 
NY aaa 1 00:38:3] EBASRTL SRE IBASOPEN. 832-91 9 10) 
50 04 A 9 150 MOVAB 4(R8), RO F 
9 1 154 RB 23$ : 
5 D0 001 : 338 MOVL. SZ, RO : 
| 51 C4 001 $ MULL2 R1, R : 1613 
5 03 ¢0 15¢ ADDL a3. R : 1612 
50 0 A 90155 BICB #3, R 3 161 
| 14 30 D1 0168 CMPL RO, #20 : 1612 
0 18 016 BGEG © 24$ ; 
50 14 00 00167 MOVL #20, RO : 
40 AE 50 DO 0016A 24$: MOVL RO, BLS ; 
50 D4 O16 CLRL =. RO + 1625 
000000006 90 if; 01 JSB BAS$$CB_PUSH : 
50. AE B 00 00176 MOVL CCB, UNQIND_CCB + 1629 
54 OA 01 00 Bota MOVL #1, UNWIND _ACTION 3: 1630 
26 FC =AB CES 0017 BLBC ©=—_ = 4 (CCB) + 1637 
000000006 00 00 Fe 0018 CALLS #0, QT SSSCLOSE_FILE + 1641 
OA 50 € 0018 BLES _—s- RO, 258 : 
7E 01 CE 0018¢ MNEGL #1, =(SP) : 
000000006 00 01 FB 0018 CALLS #1, BASS$$STOP_IO : 
000000006 00 16 00196 25s: JSB BAS$$CB_POP + 1648 
50 D4 0019C CLRL oR > 1649 
000000006 00 16 0019¢ JSB BAS$$CB_PUSH : 
50 AE 5B DO 001A4 MOVL CCB, UNQIND_CCB + 1653 
59 FC AB E QOO1A8 26$:  MOVAB <4(¢ R9 + 1664 
OA 69 E8 OOTAC BLBS (RO), 27$ / 
05 FF AB 04 £0 OO1AF BBS #4, -1(CCB), 278 : 
E8 AB D3 00184 TSTL  =24(CCB) F 
0B 13 00187 BEQL ; 
7E 00G 8F 9A 00189 27$:  MOVZBL M#BAS$K_IO CHAALR, -(SP) : 1666 
000000006 00 01 FB 001BD CALLS #1, BASSS$STOP_IO F 
50 04 AC 08 C1 001C4 28$: ADDL #8, OPEN_ARG_BLK, RO : 1673 
57 - 60 DO 001¢9 MOVL (RO), FICE NAME DESC : 
FB AB 04 A? 0 001CC MOVL 4(FILE_NAME_DEST), -8(CCB) 3 1674 
50 67 3C 00101 MOVZWL (FILE_RAME_BESC), RO > 1675 
OOFF 8F 50 61 00104 CMPW RO, #255 3 
04 18 00109 BLEQU 29§ : 
50 FF 8F 9A 001DB MOVZBL #255, RO : 
F7 AB 50 90 OO1DF 298: OVB RO, -9<(CCB) ; 
44 AE OF OOiES PUSHAB CHANNEL : 1680 
000000006 00 gi FB OO1EG CALLS a TSS$STAKE_LUN 
E 006 &F Bh 001FO MOVZBL #BASSK 19 CHAALR, -(SP) ; 
000000006 00 01 FB O01F4 CALLS #1, BAS$$STOP_IO ; 
54 OA 02 pO O1FB 30$:  MOVL #2, UNWIND_ACTION > 1685 
Se BO AD 9E OOTFF MOVAB FAB_BLOCK, FAB : 1690 
0050 =s«&F 00 bE 00 2¢ 9 05 MOVCS #0,7(SP), #0, #80, (FAB) ; 1691 
66 5003 BF 0 00208 MOVw ow 04gs (FAB) : 
1F AG 02 021 MOVB #2, 31(FAB) ; 
50 04 ac 14 C1 00214 ADDL3 # 6 OPEN_ARG_BLK, RO > 1692 
10 Ab 60 DO 00219 MOVL (ROS, 16(FA ; 
50 04 Ac 1 ¢ 0 10 ADDL3 #1, OPEN_ARG_BLK, RO > 1694 
08 AE 60 98 00 CVTBL = (RO), BSP) ; 
38 AE ps 0 § SLRL. ss 56 ( SP) ; 
03 8 AE 1 0 CMPB (SP), #3 ; 
05 12 D BNEQ 1$ ; 
AE D6 O02eF INCL 6(SP) ; 
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_BASSOPEN bese -1984 00: AX-11 Bliss-32 V4.0-742 Page 55 
ANB 1a-sep-19 2 98 3g: 31 BASRTL.SRCJBASOPEN.B32;91 9° 10) 
1D Ab 19 90 OO3AC 60$: MOvB #16, 29(F AB) 3 : 1847 
\i 0088 BRB : 
1D Ab 9 0 00382 61$:  MOVB #32, 29(FAB) + 1850 
11 88 BRB $ : 
1D Ab 94 B oes: CLRB 9 (FAB) : 1853 
04 2c 5 E3 O38B 63$:  BLBC a44(SP), 64$ + 1864 
1€ 6 8 003BF BISB2 #8, 30(FAB) : 
50 046 ac 6 C1 003C3 648 ADDL #6, OPEN_ARG_BLK, RO : 1866 
| 10 AE 60 98 003¢8 CVTBL (RO) 16tsP) : 
05 00 10 AE 8F 003CC CASEB 16(SP), #0, #5 : 
0031 0027 0021 0019 00301 65$ WORD 668- -65$,- ° ; 
0019 0020 00309 67$-65$,- ; 
685-658, - : 
0$-65$.- : 
69$-65$.- : 
66$-65$ : 
7E 006 8F 9A 00300 MOVZBL #BASSK PROLOSSOR, -(SP) + 1888 
000000006 00 01 FB 003E1 CALLS #1, BASS$$STOP_IO ; 
18 11 00368 BRB F 
01 08 AE 91 OO3EA 66$:  CMPB (SP), #1 + 1871 
12 13 OO3EE BEQL 708 ; 
06 11 003F BRB $ : 
1E 6 01 88 003F2 67$ BISB2 #1, 30(FAB) + 1874 
OA 11 0036 BRB : 
1E 6 02 88 003F8 68$:  BISB2 #2, 30(FAB) + 1877 
04 11 OO3FC BRB ; 
1E a6 04 88 OO3FE 69S BISB2 #4, 30(FAB) + 1885 
04 00 24 AE 8F 00402 70$ CASEB 36(SP), #0, #4 + 1895 
0037 0031 0028 0017 00407 71$ WORD $-71$,- © : 
000A 0040F 76$-71$.- : 
77$-71$.- : 
78$-71$.- : 
72$-71$ ; 
7E 006 8F 9A 00411 72$:  MOVZBL HBASSK PROLOSSOR, -(SP) + 1916 
000000006 00 FB 00415 CALLS BASS$SSTOP_10 : 
24 11 0041C BRB 6 F 
01 08 AE 91 0041E 73$:  CMPB (SP), #1 : 1902 
05 12 00422 BNEQ 74$ : 
50 01 D0 00424 MOVL #1, RO ; 
03 11 00427 BRB 75$ ; 
50 02 DO 00429 74$: MOVL #2, RO ; 
1F OA 50 90 0040C 75$:  MOVB RO. 31(FAB) : 1900 
10 11 00430 BRB > 1899 
1F AG 1 90 004 2 76$: #$MOVB #1, 31(FAB) : 1907 
A 11 004 BRB : 
1F AG 02 90 004 77$: MOVB 31(F AB) + 1910 
04 11 004 BRB : 
1F Ab 03 90 0043E 78$ MOVE #3, 31(F : 1913 
50 04 AC 1c ci 0442 79$ ADDL3 #26 5 OPEN AR ARG BLK, R0 > 1919 
1c Ab 60 90 0044 OVB = (ROS ; 
50 01 DO 00448 MOVL #1, fo" > 1926 
01 2 91 Dade CMPB RO. : 1929 
‘ 12 043 BNEQ 80§ ; 
4 00453 CLRL_ —- RO ; 
17 6 4 88 00455 BISB2 #4, 23(FAB) : 1930 
01 é 1 00459 80$:  CMPB R2. #1 : 1932 
05 13 0045¢ BEQL 81s ; 
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1h-s2p-19 4 :52:31 AX-11 Bliss-32 V4.0-742 Page 59 
12-8 08- 1 3be 90:38:3] BASRTL. SRC IBASOPEN. 832291 9° 10) 
05 AB 1 88 0067 B1SB #1, 5(CCB) : 
04 AB 000100 F CA Sere 129$: ties #98535, 4(CCB) + 2205 
AE ps 0670 CLRL 40(SP) t 2216 
01 AE 91 00680 CMPB sé SP), #1 : 
03 12 006 BNEQ 130$ : 
38 AE 06 06 6 INCL 40(SP) : 
1 04 AE F 06 130$: INSV. 40(SP), #4, #1, 4(CCB) : 
0 6E ven 00 2c 9690 MOVCS #0, (SP), #0, #96, SRMS_PTR : 2222 
FF50 «CD 600¢ SF BO 069A MOVW #24578, $RMS_PTR : 
50 5 A 06A1 MOVAB’ FILE_NAME, RO 3 2223 
FFSC = CD 2 D BROAS MOVL Re. NAM_BLOCK+12 3 
FF54 «CD DO OO6AA MOVL RO, NAM~BLOCK+4 : | 
FFSA CD 01 BE OO6AF MNEGB #1, NAM~BLOCK+10 3 2224 
FF52 «CD 01 8E 00684 MNEGB #1, BLOCK+2 : 
28 Ab FF50 CD 9E 00689 MOVA NAM_BLOCK, 40(FAB) 3 2225) 
6E eee 00 2c 0068 MOVCS #0, ~(SP), #0, #44, SRMS_PTR + 2233 
FF24 CD 2C1D 8F B80 006C7 MOVW #11293, $RMS_PTR : 
FF28 CD FF18 CD 9E OO6CE MOVAB XABSUM, SRMS~PTR+4 : 
6E 00 2C 006D5 MOVCS #0, (SP), #07 #12, SRMS_PTR > 2234 
FFI8 CD OO6DA : 
FF18 CD 0C16 8F B80 006DD MOVW #3094, $RMS_PTR : | 
FFIC CD D4 006E4 CLRL  XABSUM+4 + 2235 
OC AE 24 Ab SE 006E8 MOVAB 36(FAB), 12(SP) : 2236 
OC BE FF24 CD 9E OO6ED MOVAB XABFHC, @12(SP) ; | 
02 6C 91 006F CMPBs« CAP), 2 + 2241 
03 1& 0066 BGEQU § 131$ : 
0228 31 006F8 BRW 161$ : 
20 AE 08 AC DO 006FB 131$: MOVL  KEY_INFO BLK, 32(SP) : 2257 
59 08 BC 9A 00700 MOVZBL @KEY_INFO_BLK, KEYNO 3 | 
0214 31 00704 BRW 159$ : 
20 AE 01 €1 00707 132$:  ADDL3 #1, 32(SP), R1 : 
50 61 9A 0070C MOVZBL (R1), RO : 
50 59 C4 0070F MULL2  KEYNO, RO : 
50 08 AC CO 00712 ADDL2 KEY_INFO_BLK, RO : 
57 04 AO SE 00716 MOVAB 4(RO), KEY_PT ; 
48 AE OF OO7IA PUSHAB XABKEY : 2263. 
20 AE 4C 8F 9A 0071D MOVZBL #76, 32(SP) : 
20 AE 9F 00722 USHAB 30($P) ; 
000000006 00 0 FB 00725 CALLS #2, LIBSGET_VM : 
0B 5 E 0072C LBS GEf_VM_STATOS, 1 : 2265 
7E 006 8F 9A O072F MOVZBL #BASSK~MAXMEMEXC, (SP) ; 
000000006 00 o1 FB 007 3 CALLS #1, BASSSSTOP_ : 
0 6 i 00 2c 075A 1338: MOvcS #0, (SP), #0,-#76, @XABKEY : 2268 
48 BE 1 90 $0748 MOVB #21, @XABKEY : 
48 AE 01 ¢1 00747 ADDL3 #1, XABKEY, RO : 
60 4C BF 90 0074 MOVE. #76, ( : 
48 AE 13 C1 0075 ADDL3 #19, XABKEY, RO : 
60 94 9079 CLRB (R05 : 
48 AE 17 C1 O79? ADDL3 #23, XABKEY, RO : 2272 
60 59 90 0075¢c MOVB KEYNO, (RO) : 
48 «OA Ht C1 0075F ADDL3 #30, XABKEY, RO : 2273 
6 02 A? BO 00764 VW  2(KEY_PTR), (RO ; 
48 «OA ef C1 BO 708 ADDL3 #46, RABKE : 2274 
6 67 90 00760 VB = (KEY_PTR), (RO : 
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nN 5 
| BASSOPEN 16-Sep-1984 00:52:31 AX-11 Bliss-32 V4.0-742 P 4 
any 1eagee= 138s 99:88:35, HANSAT Ob dese Re ene S320 age 8 
50 FFS3. CD 9A OOAA MOVZBL NAM_BLOCK+3, RO : 2606 
peas gay a 
FB AB FFS4 6 f net oaee NAM _BLOCK+4, -8(CCB) : 3616 
| 50 FSB CD 9A QOARC 1818: MOVZBL NAM BLOCK+IT, RO : 3614 
FB OAB FFSC CD Ne MOVL § NAM BLOCK+12, -8(CCB) + 2617 
F7 AB 8 Bf Be 1828: MOVE RO, ~=9(CCB) : gb 
OA 33 ES ACD 183$: LBS OPEN. STATUS, 184$ : 2630 
000000006 00 ¢ FB yt CALLS #1. BAS$$STOP_IO : 
54 «AE 93 4h 3 184$:  MOVL #3, UNWIND _ACTION 3: 263 
OA E8 OOADE BLBS CONNECT STATUS, 185$ : 263 
E 03 CE OOAE1 MNEGL #3, -(SB) : 
000000006 00 01 FB OOAE4 CALLS #1. BAS$$STOP_IO : 
6D 20 8B OA EO OOAEB 185$: BS #16, a32(SP),7190$ + 2646. 
5 40 A6 DO OOAFO MOVL  64(FAB), R2 : 2650) 
3D 5 02 FI Oars C #2 R2, 188$ : | 
20 BE 20 88 OOAF8 BISB2 #32, a$2(SP) t 2657 
30 AB OF OOAFC PUSHAB 48(CCB + 2659 
20 AE 50 8F «9A OOAFF MOVZBL #80, 32(SP) : 
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4C AE 62 D 19 MOVL §(XAB_PTR), XABKEY > 3314 
50 4C AE DO 01004 MOVL XABKEY, RO : ; 23 
15 4C BE 91 01008 CMPB = @XABKEY, #21 : 3316 
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Bc 99:38:3. — EBASATLoSReSeasoPeicese791 


eres 

4(RO), (XAB_PTR) 
XABKEY 

#76, 68(SP) 
68(5P) 


WBASSK BADRECVAL, =(SP) 
#1, BASSS$STOP_I0 


=46(CCB), 68(SP) 
(SP) 


BMOt t | B~ BM 
eo me 
Aad 


) 
IBSGET_VM 
M_RESUCT, 296$ 
K"MAXMEMEXC, =(SP) 
ASSS$STOP_10 
CCB), RO 

(9 b_ADDRESS), a-8(CCB) 
ia (SP) 


om 


1 


2978 
TH 


Save nothing 
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assy” 1e-8ep-19 4 11: wg 7 BASRTL. SRC JBASOPEN.B32;91 9° 10) 

50 08 AC DO 010F4 MOVL  8(AP), RO : 

50 04 AO BO 01088 MOVL  4(RO), RO : 

FE10 §=6CO «OF 010FC PUSHAB UNWIND_CCB : 

FEIG €O 9F 01100 PUSHAB UNWIND-ACTION : 

02 DD 01104 PUSHL #2 : 

SE DD 01106 PUSHL SP : 

7E 04 AC 7D 01108 MOVa 4(AP), (SP) : 

0000v CF 03 FB 0110¢ CALLS #3, OPEN. HANDLER ; 

04 01111 RET : 


; Routine Size: 4370 bytes, Routine Base: _BASSCODE + 0000 


: 2502 3420 1 


WAINIAWN NANA NAANAAANNAA NAAN 


WA 
De a a a ee et ee ee ek et ek ek ek ek ek ek ee ak ek ek ee 


PPPS BB BS BS BE WW 


oO 
AAG 


IWIWWINIWIARSRORORORONORO PUN 2 = OO 
PREP ER RRP R EERE 
SODNAPL EWN $O OONAUS WR OODNAMNE WO ODN EWN 


A re IIIIIIIIIIS 
an 
_ 


PIP IPIPOPIAPIPOPINPPNGAIPNYNINYNIDINID) 9 i OO OO 0 SS SS 


CODON EWN OC OONOUE WN OOM! 


HAAN MAG Nan 


BASRTL.SRC JBASOPEN.B32;91 (11) 


' Handle an UNWIND from OPEN 


! Signal vector 


J 6 
1o=ge0= 138 90: 38:3] ret Oi fegere V4.0-742 Page 73 
ROUTINE OPEN_HANDLER ( ' 
$1G 
i 


i COMPLETION CODES: 
Always SS$_RESIGNAL, which is ignored when unwinding. 
i SIDE EFFECTS: 
i May RMS CLOSE or DISCONNECT the file, and may deallocate the CCB. 


MECH, ' Mechanism vector 
, ENBL ! Enable vector 
= 
lee 
} FUNCTIONAL DESCRIPTION: 
: If we are ag tap do the indicated OPEN cleanup, either nosy ine. POP 
i the CCB, mark the CCB for deallocation and POP it, or RMS CLOSE the CCB 
and POP it. 
i FORMAL PARAMETERS: 
: $1G.rl.a A counted vector of parameters to LIBSSIGNAL/STOP 
: MECH. rl.a A counted vector of info from CHF 
ENBL.ra.a A counted vector of ENABLE argument addresses. 
IMPLICIT INPUTS: 
; NONE 
IMPLICIT OUTPUTS: 
NONE 
' 
' 
1 
! 
! 
' 
' 
1 
1 


BEGIN 


MAP 
SIG : REF VECTOR, 
MECH : REF VECTOR, 
ENBL : REF VECTOR; 
LOCAL 


MY_UNWIND_ACT : VOLATILE, 
MYTUNWIND=CCB : VOLATILE; 


GLOBAL REGISTER 
CCB = K_CCB_REG : REF BLOCK C, BYTE); 
'¢ 
: Define names for the two items in the ENABLE vector. 


BIND 
UNWIND_ACTION = .ENBL (1), 


_o 

WIV = 

AAA aS 
VMPwr— 
NOU WR OOo 


02 G0 09 00 C9 CO CD Co SI 


S at ek ee ee et ee ee 


08090909 SI NIN INI NININNSIO OO 
Be ek at at ek ee ke ee 
woovnowowoovowowe 
NOs —CcOo 


bab Ad Ab Ab Ae poner en eneneheierdndet yo > ¥ 


FSPSSISSES 


s DPA AAPAAAA AAAI 
Sss 
= on 


PIPIPIPIPINGPIPININIPIPYAIPINININIPINIPINPINIPIPI POPPIN PPUPUNINOPOPONonononopofnofnonony 
sss OOoonn 
SSSSSSSS 


bey yt tee ty ty yt tty ty ey ty ty ty het ty te ty tate te eet PIV IIIIIIIII~IIIIIIIIG 


Be Se Se Se Se Se Se Ge Ge Fe Se Se FH Se Ge Ge Be ee FH Se Se FH Se Be Se Ge Fe Se Se Se Ge Se Ge Ge Se Ge Se ee FHS Se Se SH Ge SF Se S565 Se OH Se Se ee HSH Se as 


QPP PV PVP DVIPS SUSU SISSIES IT 


WANA AIPPPIPINININININIDD 4 2 9 OOO MH OOOOOOOCOCO SO 
PWN 0 ODO VE WN 09 OODNAVE WIN “OO ONOUE WIN OO 


Romonononofonofonoponony 


PARRA 
et et ed et dd 


NO UEWIN © 


K 6 
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ease 138s 99:88:38, Peat tte sekzobtn secon 29e 4t) 


UNWIND_CCB = .ENBL (2); 


14 
We are our own handler, in case the CLOSE or DISCONNECT fails. 


ENABLE 

OPEN_HANDLER (MY_UNWIND_ACT, MY_UNWIND_CCB); 

'¢ 

Don't do anything yet. 

= MY_UNWIND_ACT = UNWIND_NOP; 

i just resignal if this is an UNWIND or if the error is not severe. Otherwise 

we clean up the 1/0 data base prior to signalling the SEVERE error. 

i CLIBSRATCH_ COND (SIG Ci], ZREF (SSS_UNWIND)) OR (.BLOCK CSIG [1], STSS$V_SEVERITY] NEQ STSS$K_SEVERE)) 

RETURN (SS$_RESIGNAL); 


'¢ 
Depending on the action selected, do things. 


CCB = .UNWIND_CCB; 
a FROM UNWIND_MIN TO UNWIND_MAX OF 


CUNWIND_NOP] : ! Do nothing. 
BEGIN 
END; 
CUNWIND_ POP) : ! POP the specified CCB 
BASS$CB_POP (); 
TunnINe DEALLECS : ! Mark the specified CCB for deallocation, then POP it 


CCB CLUBSV_DEALLOC) = 1; 
BASSSCB_POP O; 


'¢ 
: RMS CLOSE or DISCONNECT the specified CCB (which marks it for deallocation), then POP it 
(which will usually deallocate it). 
CUNWIND CLOSE] : 
BEGIN 


'¢ 


: If the CLOSE fails, deallocate and POP. 


MY_UNWIND_CCB = .CCB; 
MY"UNWIND"ACT = UNWIND_DEALLOC; 


IF ( NOT OTSSSCLOSE_FILE ()) THEN BASSS$STOP_10 (BASSK_IOERR_REC); 


e 


6 
| BASSOPEN 1b-se -1984 00:52:31 AX-11 Bliss-32 V4.0-742 Page 75 
1-11 a aets 1 90:38 :3) YBASRTL SRE BASOPEN.B32;91 . (11) 
5 
§ BASSSCB_POP (); 
END; 
8 TES; 
539 
540 
541 


RETURN (SS$_RESIGNAL); 
END; 


1 
1 


FAAAAAS 
Prwn—O0@w 


! end of OPEN_HANDLER 


0804 00000 OPEN_HANDLER: 
WORD 


Save R2,R11 : 3421 
52 0c aC 00 00002 MOVL Ll, 3 3477. 
7E 7C 00006 CLRQ  MY_UNWIND_CCB : 3478 
6D 0065 CF DE 00008 MOVAL 6%, (FP) : 
04 AE b4 00000 CLRL = MY yNW IND ACT : 3490 
7E 0920 8F 3C 00010 MOVZ2WL #2336, -(SP) 3 3496 
5E 0D 00015 PUSHL 3 
58 04 AC 00 00017 MOVL S1G, R11 : 
04 AB 9F 0001B PUSHAB 4(R11) : 
000000006 00 0¢ FB 4d CALLS #2, LIBSMATCH_COND : 
43 E8 0002 BLBS ° 3 
04 04 AB 03 0 €ED 00028 CMPZV) «#0, #3, 4(R11), #4 : 
B 12 0002E BNEQ 5$ $ 
58 08 B62 00 00030 OVL a8(R2), CCB ; 3503 
03 00 04 B2 CF 00034 CASEL a@4(R2), #0, : 3505 
0010 OO0A 002C 0032 00039 1$ WORD 13-13-* 3 
$-1$,- : 
$-1$ : 
28 11 00041 BRB 5$ : 3509 
FF AB 10 88 00043 2$: BISB2 #16, -1(CCB) : 3518 
1C 11 00047 BRB 4$ : 3519 
06 AE 5B DO 00049 3$: MOVL CCB, MY_UNWIND_CCB 3 3531 
08 AE 02 bd0 00040 MOVL #2, MY_ONWIND ACT : 3532. 
00000000G 00 00 4) 00051 CALLS #0, OTSSSCLOSE_FILE 3: 3534 
OA 50 €8 00058 BLBS RO, 4$ 3 
7E 01 CE 00058 MNEGL #1, -(SP) : 
00000000G 00 01 FB 64 CALLS #1, BAS$$STOP_IO $ 
000000006 00 16 00065 4$: JSB BASSSCB POP : 3536 
50 0918 8F 3C sie 5$: MOVZWL #2328, RO : 3540 
Be i RET 3 $254 
0000 00071 6$: - WORD pexe nothing : 3478 
50 08 AC 00 te MOVL (AP), RO 3 
50 04 AO 00 0007 MOVL 4(RO), RO F 
F8 AO 9F 00078 PUSHAB MY_UNWIND_CCB ; 
FC AO 9F OOO7E PUSHAB MY_UNWIND"ACT : 
Qe DD 00081 PUSHL #2 F 
E bb 9083 PUSHL SP ; 
7E 04 AC 7D 0008 vO. 4(AP), =(SP) : 
FF72 CF 03 FB 00089 CALLS #3, OPEN_HANDLER ; 
04 O0008E RET 3 
; Routine Size: 143 bytes, Routine Base: _BASSCODE + 1112 


if: sep 1984 99:38:31 


AX-11 a 
BASRTL.S 


neSaacopencs 


3301 


Page 7 


(11). 


N 6 
ra 1erSep-19b6 1:88:06 EBASRTLSSRe SeaSoPLA.082;91 


: $3 } GLOBAL ROUTINE BASS$STATUS ! Status of last file opened 
; 2629 45 1 

3; 2650 re 1 fe¢ 

: > 1 ef } FUNCTIONAL DESCRIPTION: 

; 26 g 549 1! Get the status of the last file opened. The necessary bits 

3 : ¢ 229 ! } were saved by OPEN in L_STATUS. 

3; 2636 226 1 ! FORMAL PARAMETERS: 

: $038 ae 1 i NONE 

$ o36 238 1! 

3; 2640 556 1 ! IMPLICIT INPUTS: 

3; 2641 557 1! 

3 a6 558 1! L_STATUS A copy of FABSL_DEV from the Last OPEN, or 0 

3 264 5539 17! 

; sete 560 1 ! IMPLICIT OUTPUTS: 

3 2645 561 1! 

3: 2646 206 1! NONE 

3: 2647 3563 1! 

3; 2648 3564 1 ! ROUTINE VALUE: 

3: 2649 3565 1 ! COMPLETION CODES: 

3 $o20 $208 1! 

: o2) seen ! : Bits 0 through 4 reflect device characteristics, see below. 

3; 265 3569 1 ! SIDE EFFECTS: 

3; 2654 3570 1! 

3: 2655 i eS NONE 

3 2656 3276 1! 

; 2657 3573 1 I= 

>; 2658 3574 1 

3; 2659 $252 BEGIN 

3; 2660 576 ‘+ ; 

: 2661 3577 ! The following field describes the status bits returned. 

; O66 3578 § !- 

3; 266 579 

> 2664 580 FIELD 

3: 2665 581 STATUS_BITS = 

; soe8 28¢ T 

3 266 58 STATUS_REC = (0, 0, 1, 0), ! Record-oriented device 
3 2668 aR STATUS_CCL = (0, 1, 1, OJ, ! Carriage control device 
3 2669 585 STATUS_TRM = (CO, ¢ 1, 0), ! Device is a terminal 

3 2670 236 STATUS_DIR = 8. o 1. Q). : Directory device (disk) 
3: 2671 5 STATUS_SDI = CO, 4, 1, s ! Single-directory device 
: o7 388 pratus 500 = (0, 5, 1, 0) ' Sequential, block-oriented device (magtape) 
3 2674 590 

3; 2675 591 LOCAL 

s 4h 236 STATUS : BLOCK (C2, BYTE) FIELD (STATUS_BITS); 

3: 267 594 '¢ 

3 vt $02 : Clear all of the bits in STATUS, then set the appropriate ones. 

: vet $99 STATUS = 0; 

; 268 599 IF ((.LUSTATUS AND DEVSM_REC) NEQ 0) THEN STATUS CSTATUS_REC) = 1; 
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kaise Ver$sb-1986 11:55:34 EBasRtLSReSBASoPEN aso—91 9°12) 
3; 26846 600 
; 8 601 IF ((.LUSTATUS AND DEVS$M_CCL) NEQ 0) THEN STATUS CSTATUS_CCL] = 1; 
; 687 608 IF ((.LLSTATUS AND DEVSM_TRM) NEQ 0) THEN STATUS CSTATUS_TRM] = 1; 
; 689 605 IF ((.LUSTATUS AND DEVSM_DIR) NEQ 0) THEN STATUS [STATUS_DIR] = 1; 
: 691 607 IF ((.LSTATUS AND DEVSM_SDI) NEQ 0) THEN STATUS CSTATUS_SDI) = 1; 
; 3638 3609 IF ((.L STATUS AND DEVSM_SQD) NEQ 0) THEN STATUS CSTATUS_SQD} = 1; 
: 2695 611 2 '4 
3; 2696 a8 i Return the bits as our value. 
3; 2697 61 ie 
: 2698 3614 RETURN (.STATUS); 
3; 2699 615 END; ! of routine BAS$STATUS 
0000 00000 .ENTRY BASSSTATUS, Save nothing : 3543. 
51 B4 00002 CLRW STATUS : 3597 
50 00000000' EF 09 00004 MOVL L_STATUS, RO : 3599) 
03 50 E 00008 BLBC. —_-«aRO,_ 18 : 
51 01 88 9000 BISB2 #1. STATUS : 
03 50 01 Ei 0011 1$: BBC #1, RO, : 3601 
51 02 88 00015 BISB2 #2. STATUS F 
03 50 02 a 00018 2$ #2, RO : 3603 
51 04 88 0001C BISB2 #4. STATUS ; | 
03 50 03 EI OOO1F 3$ #3, RO : 3605 
51 08 88 00023 B1SB2 48, STATUS ; | 
03 50 04 EI 00026 4$: BBC RO, 5$ : 3607. 
51 10 88 O002A BISB2 nib. STATUS ; | 
03 50 05 €1 0002D S$: BBC “Rd : 3609 
51 20 bs 00031 BISB2 #32, STATUS | 
50 1 3C 00034 68: MOVZWL erst US, RO > 3614 
04 00037 RET : 3615 
; Routine Size: 56 bytes, Routine Base: _BASSCODE + 11A1 


; 2700 3616 1 


] 


—m 


BASSOPEN 1 
easyg 1 

4 ei? ! GLOBAL ROUTINE BASSS$STATU_INIT : NOVALUE 
704 619 1 !44 
tp? Y : FUNCTIONAL DESCRIPTION: 
70 6 § 1 7 Initialize the STATUS variable. 
rs ? : s not the first RUN command in t 
710 625 1 ! FORMAL PARAMETERS: 
711 6 $ ; 3 
ay 6 , NONE 
71 628 1! 
714 629 1 ! IMPLICIT INPUTS: 
715 630 1! 

stig 631 1! NONE 
717 6 ¢ » 3 

2718 633 1 ! IMPLICIT OUTPUTS: 

2719 $038 1! 

2720 635 1! L_STATUS, always zet to zero. 

2721 3636 1! 

sis¢ 3637 1 ! ROUTINE VALUE: 

sis 3638 1 ! COMPLETION CODES: 
724 3639 1! 

2725 eat 1! NONE 

2726 641 1! 

2727 ak) 1 ! SIDE EFFECTS: 

2728 3645 1! 

sie) 3644 1! NONE 

273) 3645 1! 

275) 3646 1 !-- 

2732 3647 1 

2733 3648 2 BEGI 

2734 3649 2 L_STATUS = 0; 

2735 3650 1 END; 


0000 00000 


; Routine Size: 9 bytes, Routine Base: _BASSCODE + 1109 
; 2736 3651 1 

3; 2737 O34 1 END 

; $358 6535 1 

3; 2739 654 0 ELUDOM 


: PSECT SUMMARY 


9 
Bee Oe Ge Se Be Oe Oe Se Ge Oe Oe Be Se SF Se Se Se Se Se SESE Se Se Se ee ee St Se SH Ss Sees | 
| 


00000000" EF 04 00002 
04 00008 


? 
Eer=1884 PSSEHEL WOKS, Sutesa bgp? 


-Sep-19 BASR 
= ! Initialize status 


BASOPEN.B32;91 


This is needed by the RUN command in case this 
his image. 


! of routine BASS$STATU_INIT 


-ENTRY BASSSSTATU_INIT, Save nothing 
CLRL L_STATUS 


! end of module BASSOPEN 
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| BASSOPEN 16-Sep-1984 00: 3¢ 31 AX-11 Bliss-32 V4.0-742 
1-113 14-Sep-1984 11:55:24 BASRTL.SRCJBASOPEN.B32;91 
B Name Bytes Attributes 

: _BASSDATA 4 NOVEC, WRT, RD ,NOEXE,NOSHR, LCL, REL, CON, bg beat fi 

; _BASSCODE 4578 NOVEC,NOWRT, ° —E, SHR, LCL, REL CON, PIC,ALIGN(2) 

: Library Statistics 

: en POE eons ne ee ymbols -------- Pages Processing 

: File Total Loaded Percent Mapped Time 

: _$255$DUA28:CSYSLIBISTARLET.L32;1 9776 188 1 581 00:01.2 

COMMAND QUALIFIERS 
; Size: 4578 code + 4 data bytes 
Run Time: 01:55.7 


Elapsed Time: 04:15.6 
Lines/CPU Min: 1894 
Lexemes/CPU-Min: 18938 
penety Used: 1272 pages 
ation Complete 


Compi 


BLISS/CHECK=(FIELD, INITIAL,OPTIMIZE) /NOTRACE/LIS=LIS$:BASOPEN/OBJ=0BJ$:BASOPEN MSRC$:BASOPEN/UPDATE=(ENH$:BASOPEN) 


Pane 18) 
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